Zoom to Selected features

Question

Не подскажет ли кто как сделать на VisualBasic6 или на VisualC++ функцию "Zoom to Selected features"? У меня есть функция которая выделяет обьекты по арибуту и хотелось бы автоматически после её применения перейти к выделеным объектам.

Answer 1

Для отображения ОДНОГО выбранного объекта
используется следующий код
 
 Dim env As IEnvelope
   
   Set env = pFeat.Shape.Envelope
   env.Expand 2, 2, True ' не обязательно
  
  
   pMxDoc.ActiveView.Extent = env

   pMxDoc.ActiveView.Refresh
   pMxDoc.UpdateContents

А это я нашел в хелпе

Public Sub ZoomInCenter()
  Dim pMxDocument As IMxDocument
  Dim pActiveView As IActiveView
  Dim pDisplayTransform As IDisplayTransformation
  Dim pEnvelope As IEnvelope
  Dim pCenterPoint As IPoint

  Set pMxDocument = Application.Document
  Set pActiveView = pMxDocument.FocusMap
  Set pDisplayTransform = pActiveView.ScreenDisplay.DisplayTransformation
  Set pEnvelope = pDisplayTransform.VisibleBounds
  'In this case, we could have set pEnvelope to IActiveView::Extent
  'Set pEnvelope = pActiveView.Extent
  Set pCenterPoint = New Point
  
  pCenterPoint.x = ((pEnvelope.XMax - pEnvelope.XMin) / 2) + pEnvelope.XMin
  pCenterPoint.y = ((pEnvelope.YMax - pEnvelope.YMin) / 2) + pEnvelope.YMin
  pEnvelope.width = pEnvelope.width / 2
  pEnvelope.height = pEnvelope.height / 2
  pEnvelope.CenterAt pCenterPoint
  pDisplayTransform.VisibleBounds = pEnvelope
  pActiveView.Refresh
End Sub

Answer 2

Вот, родил

Public Sub zoom()



   Dim env As IEnvelope

   Dim dMaxX As Double, dMaxY As Double
   Dim dMinX As Double, dMinY As Double
  
   Dim pEnumF As IEnumFeature
   Dim pFeature As IFeature
  
   dMaxX = 0
   dMaxY = 0
   dMinX = 0
   dMinY = 0
  
   Set pMxDoc = ThisDocument
  
   Set pEnumF = pMxDoc.FocusMap.FeatureSelection
  
   Set pFeature = pEnumF.Next
  
   dMaxX = pFeature.Shape.Envelope.XMax
   dMaxY = pFeature.Shape.Envelope.YMax
   dMinX = pFeature.Shape.Envelope.XMin
   dMinY = pFeature.Shape.Envelope.YMin
  
   Do Until pFeature Is Nothing
  
    If pFeature.Shape.Envelope.XMax > dMaxX Then
   
        dMaxX = pFeature.Shape.Envelope.XMax
   
    End If
   
    If pFeature.Shape.Envelope.YMax > dMaxY Then
   
        dMaxY = pFeature.Shape.Envelope.YMax
   
    End If
   
    If pFeature.Shape.Envelope.XMin < dMinX Then
   
        dMinX = pFeature.Shape.Envelope.XMin
   
    End If
   
    If pFeature.Shape.Envelope.YMin < dMinY Then
   
        dMinY = pFeature.Shape.Envelope.YMin
   
    End If
  
   Set pFeature = pEnumF.Next
  
   Loop
  
   Set env = New Envelope
  
   env.XMax = dMaxX
   env.YMax = dMaxY
   env.XMin = dMinX
   env.YMin = dMinY
  
  
   'env.Expand 2, 2, True
  
   pMxDoc.ActiveView.Extent = env
   pMxDoc.ActiveView.Refresh
   pMxDoc.UpdateContents
   
  
End Sub

Answer 3

огромное человеческое спасибо!