vba13-8.txt

AO的原代码,都是以TXT的文件写的,对你肯定有帮助的.这些都是 我的心血啊.

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