vba13-8.txt

来自「本书给出了AO的常用的VAB代码 可能是初学者很好的一本参考书」· 文本 代码 · 共 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