基于AE的三维查询源代码_ae伪三维代码-CSDN博客

基于AE的三维查询源代码

Public Type m_pObjArray
   iFeature As iFeature
   iLayerName As String
End Type
Public M_pFeatureArray() As m_pObjArray

Private Sub ArcSceneControl_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
            ArcSceneControl.SceneGraph.IsNavigating = False
            Call Identify3DMap(X, Y)
end sub

'输入:当前3D地图，x坐标,y坐标,引用公共变量M_pFeatureArray
'输出:对3D地图上的目标选中，调用frmidentify显示选中目标的信息
'功能:单点查询
'程序:tjh 2005.1.29
Private Sub Identify3DMap(X As Long, Y As Long)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

      'QI for IBasicMap from IScene
   Dim pBasicMap As IBasicMap
   Set pBasicMap = ArcSceneControl.SceneGraph.Scene
   'QI for IScreenDisplay from ISceneGraph
   Dim pScreenDisplay As IScreenDisplay
   Set pScreenDisplay = ArcSceneControl.SceneGraph

   'Translate screen coordinates into mulitple 3D objects
   Dim pHit3DSet As IHit3DSet
   ArcSceneControl.SceneGraph.LocateMultiple ArcSceneControl.SceneGraph.ActiveViewer, X, Y, esriScenePickGeography, False, pHit3DSet

   'Reduce the hit set to the top
   'most hits and one hit per layer
   pHit3DSet.Topmost 1.5
   pHit3DSet.OnePerLayer
   pHit3DSet.Topmost 1.1

   'Get an array of hits
   Dim pArray As IArray
   Set pArray = pHit3DSet.Hits
   If pArray.Count = 0 Then Exit Sub

   'Loop through each hit
   Dim i As Integer
   ReDim M_pFeatureArray(0)
   For i = 0 To pArray.Count - 1

      'Get the hit
      Dim pHit3D As IHit3D
      Set pHit3D = pArray.Element(i)
      'Get the hit location
      Dim pPoint As IPoint
      Set pPoint = pHit3D.Point
      If pPoint Is Nothing Then Exit Sub
      'Get the layer that was hit
      If Not TypeOf pHit3D.Owner Is ILayer Then Exit Sub
      Dim pLayer As ILayer
      Set pLayer = pHit3D.Owner
      'Get the feature that was hit
      Dim pObject As IUnknown
      Set pObject = pHit3D.object

      'Add to identify dialog
      ReDim Preserve M_pFeatureArray(UBound(M_pFeatureArray) + 1)
      Dim pFeature As iFeature
      Set pFeature = pHit3D.object
      Set M_pFeatureArray(UBound(M_pFeatureArray) - 1).iFeature = pFeature
      M_pFeatureArray(UBound(M_pFeatureArray) - 1).iLayerName = CStr(pLayer.Name)

   Next i

   '''''''''''''''''''''''''''''''''''''''''''''''''
   If frmIdentify.Visible = False Then
      frmIdentify.Show 0
   End If
   frmIdentify.SetFocus
   Call frmIdentify.InitTreeView
End Sub