English

How To: Zoom to the extent of a layer containing route events

Summary

The Zoom to Layer command, in the Table of Contents feature layer context menu, does not zoom to the extent of the events in a layer based on route events. The Zoom to Layer command zooms to the extent of the route feature class upon which the events are based.

Procedure

  1. Create a UIButtonControl.

    Note:
    For information on creating a UIControl see the ArcGIS Desktop Help topic 'How to create custom commands with VBA'.

  2. Right-click the UIButtonControl and select View Source.
  3. Paste the code into the UIButtonClick event.

    Sub ZoomToSelectedLayer()
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pActiveView As IActiveView
    Dim pContentsView As IContentsView
    Dim pLayer As ILayer
    Dim pFLayer As IFeatureLayer
    Dim pFC As IFeatureClass
    Dim pEnv As IEnvelope
    Dim pMapSR As ISpatialReference

    Set pMxDoc = Application.Document
    Set pMap = pMxDoc.FocusMap
    Set pMapSR = pMap.SpatialReference
    Set pActiveView = pMap
    Set pContentsView = pMxDoc.CurrentContentsView

    If TypeOf pContentsView.SelectedItem Is ILayer Then
    Set pLayer = pContentsView.SelectedItem
    If TypeOf pLayer Is IFeatureLayer Then
    Set pFLayer = pLayer
    Set pFC = pFLayer.FeatureClass
    If TypeOf pFC Is IRouteEventSource Then
    Dim pGC As IGeometryCollection
    Dim pFCur As IFeatureCursor
    Dim pFeat As IFeature
    Dim pGeom As IGeometry
    Dim pSR As ISpatialReference
    Dim pRES As IRouteEventSource
    Dim pRtLoc As IRouteLocator
    Set pRES = pFC
    Set pRtLoc = pRES.RouteLocator
    Set pSR = pRtLoc.SpatialReference
    Set pFCur = pFC.Search(Nothing, False)
    Set pGC = New GeometryBag
    Set pFeat = pFCur.NextFeature
    While Not pFeat Is Nothing
    pGC.AddGeometry pFeat.ShapeCopy
    Set pFeat = pFCur.NextFeature
    Wend
    Set pGeom = pGC
    Set pGeom.SpatialReference = pSR
    pGeom.Project pMapSR 'project to map's spatial reference
    Set pEnv = pGeom.Envelope
    Else
    Set pEnv = pLayer.AreaOfInterest 'spatial reference envelope
    End If
    Else
    Set pEnv = pLayer.AreaOfInterest 'spatial reference envelope
    End If
    If Not pEnv Is Nothing Then
    If Not pEnv.IsEmpty Then
    pEnv.Expand 1.05, 1.05, True '+++ add 5% to the envelope
    pActiveView.Extent = pEnv
    pActiveView.Refresh
    End If
    End If
    End If
    End Sub


  4. Highlight the layer you wish to zoom to in the Table of Contents.
  5. Click the button you added in step 1.