vba13-8.txt

来自「一个基于ARCGIS的VBA开发代码,本人用它做过很多VBA开发,非常不错!」· 文本 代码 · 共 30 行

Private Sub SetExtent()
    Dim pMxDocument As IMxDocument
    Dim pActiveView As IActiveView
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pEnumFeature As IEnumFeature
    Dim pFeature As IFeature
    Dim pElement As IElement
    Dim pEnvelope As IEnvelope
    
    Set pMxDocument = Application.Document
    Set pActiveView = pMxDocument.FocusMap
    
    If pMxDocument.FocusMap.SelectionCount = 0 _
    Then End
    
    Set pEnvelope = New Envelope
    Set pEnumFeature = pMxDocument.FocusMap. _
    FeatureSelection
    pEnumFeature.Reset
    Set pFeature = pEnumFeature.Next
    Do While Not pFeature Is Nothing
        pEnvelope.Union pFeature.Extent
        Set pFeature = pEnumFeature.Next
    Loop
    
    pActiveView.Extent = pEnvelope
    pActiveView.Refresh

End Sub