缩放到选中的另一种实现

最新推荐文章于 2024-07-02 11:50:11 发布

原创最新推荐文章于 2024-07-02 11:50:11 发布 · 418 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#features

Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap

Dim pLayer As IFeatureLayer
Dim pFSel As IFeatureSelection
Set pLayer = pMap.Layer(0)
Set pFSel = pLayer

'Get the selected features
Dim pSelSet As ISelectionSet
Set pSelSet = pFSel.SelectionSet

Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind

Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelSet

Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment

Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)

pDoc.ActiveView.Extent = pGeom.Envelope
pDoc.ActiveView.Refresh