Archived Forums

Dim pMxDoc As IMxDocument
Dim pActiveView As IActiveView
Set pMxDoc = ThisDocument
Dim pMaps As IMaps
Set pMaps = pMxDoc.Maps
Dim pLH As IMap
Set pLH = pMaps.Item(0)
Dim pFLayer As ILayer
Set pFLayer = pLH.Layer(0)
Set pActiveView = pLH
Dim pDefine As IFeatureLayerDefinition
Set pDefine = pFLayer
If pLH.Layer(0) Is Nothing Then Exit Sub
  pActiveView.Extent = pLH.Layer(0).AreaOfInterest
  Dim pCommandItem As ICommandItem
  Set pCommandItem = Application.Document.CommandBars.Find(ArcId.PanZoom_ZoomOutFixed)
  
  pCommandItem.Execute

Public Sub ZoomToLayer()
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pActiveView As IActiveView
  
  Set pMxDoc = Application.Document
  Set pMap = pMxDoc.FocusMap
  Set pActiveView = pMap
  
  If pMap.Layer(0) Is Nothing Then Exit Sub
  pActiveView.Extent = pMap.Layer(0).AreaOfInterest
  pActiveView.Refresh
End Sub

Sub Zoom_Click()

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pDTab As IDisplayTable
    Dim pContentsView As IContentsView
    Dim pLayer As ILayer
    Set pContentsView = pMxDoc.CurrentContentsView

    If Not TypeOf pContentsView.SelectedItem Is ILayer Then Exit Sub
    Set pDTab = pContentsView.SelectedItem
    
    Dim pFCur As IFeatureCursor
    Set pFCur = pDTab.SearchDisplayTable(Nothing, False)
    
    Dim pEnv As IEnvelope
    Dim pFeat As IFeature
    Set pFeat = pFCur.NextFeature
    Do While Not pFeat Is Nothing
        If pEnv Is Nothing Then
            Set pEnv = New Envelope
            Set pEnv = pFeat.Shape.Envelope
        Else
            pEnv.Union pFeat.Shape.Envelope
        End If
        Set pFeat = pFCur.NextFeature
    Loop
    If Not pEnv Is Nothing Then
        pMxDoc.ActivatedView.Extent = pEnv
        pMxDoc.ActivatedView.Refresh
    End If

End Sub

Dim pMap As IMap
  Dim pActiveViews As IActiveView
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureSelection As IFeatureSelection
  Dim pQueryFilter As IQueryFilter
  
  Set pMxDoc = Application.Document
  Set pMap = pMxDoc.FocusMap
  Set pActiveViews = pMap
  
  in the map
  If Not TypeOf pMap.Layer(0) Is IFeatureLayer Then Exit Sub
  Set pFeatureLayer = pMap.Layer(0)
  Set pFeatureSelection = pFeatureLayer 'QI
  
    Set pQueryFilter = New QueryFilter
  pQueryFilter.WhereClause = "IPM_NUMBER > '0'"
  
  
  pActiveViews.PartialRefresh esriViewGeoSelection, Nothing, Nothing
    pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
  
  pActiveViews.PartialRefresh esriViewGeoSelection, Nothing, Nothing
   
  Dim pCommandItem As ICommandItem
  Set pCommandItem = Application.Document.CommandBars.Find(ArcId.Query_ZoomToSelected)
  pCommandItem.Execute
  
  Dim pCommandItems As ICommandItem
  Set pCommandItems = Application.Document.CommandBars.Find(ArcId.Query_ClearSelection)
  
  pCommandItems.Execute
  
pMxDoc.ActiveView.Refresh