vba14-4.txt

来自「ao的一些代码集合」· 文本 代码 · 共 36 行

Private Function ZoomToSelected() As Boolean
    ' Zoom to the selection.
    Dim pMxDocument As IMxDocument
    Dim pMap As IMap
    Dim pActiveView As IActiveView
    Set pMxDocument = Application.Document
    Set pMap = pMxDocument.FocusMap
    ZoomToSelected = False
    ' Do not change the extent if there are
    ' no selected features.
    If pMap.SelectionCount > 0 Then
        Dim pEnumFeature As IEnumFeature
        Dim pFeature As IFeature
        Dim pEnvelope As IEnvelope
        ' Retrieve the selected features and
        ' get selections' extent.
        Set pEnumFeature = pMap.FeatureSelection
        pEnumFeature.Reset
        Set pFeature = pEnumFeature.Next
        Set pEnvelope = New Envelope
        Do While Not pFeature Is Nothing
            ' The new extent is combination
            ' of selected feature's extents.
            pEnvelope.Union pFeature.Extent
            Set pFeature = pEnumFeature.Next
        Loop
        pEnvelope.Expand 1.1, 1.1, True
        ' Set map's extent to the
        ' selections' extent.
        Set pActiveView = pMap
        pActiveView.Extent = pEnvelope
        pActiveView.Refresh
        ZoomToSelected = True
    End If
End Function