基于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
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
Private m_hwndTV As Long
'输入:外部公共变量M_pFeatureArray
'输出:
'功能:将查询到的目标的属性和所属图层添加到treeview中
'程序:tjh 2005.1.29
Public Sub InitTreeView()
Dim i As Long, j As Long
Dim blCheck As Boolean
On Error Resume Next
TreeView.Nodes.Clear
For i = 0 To UBound(M_pFeatureArray) - 1
blCheck = False
For j = 0 To ComboLayer.ListCount
If M_pFeatureArray(i).iLayerName = ComboLayer.List(j) Then
blCheck = True
Exit For
End If
Next j
If blCheck = False Then
ComboLayer.AddItem M_pFeatureArray(i).iLayerName
End If
Next i
''''''''''''''''定制treeview树节点树'''''''''''''''''''''
MSFlexGrid.cols = 2
MSFlexGrid.ColAlignment(1) = flexAlignLeftCenter
MSFlexGrid.TextMatrix(0, 0) = "字段"
MSFlexGrid.ColWidth(0) = 1600
MSFlexGrid.ColWidth(1) = 2500
MSFlexGrid.TextMatrix(0, 1) = "值"
If UBound(M_pFeatureArray) = 0 Then Exit Sub
Dim Node1 As Node
Dim Node2 As Node
ComboLayer.Text = ComboLayer.List(0)
For i = 0 To ComboLayer.ListCount - 1
Set Node1 = TreeView.Nodes.Add(, , , ComboLayer.List(i))
For j = 0 To UBound(M_pFeatureArray) - 1
If M_pFeatureArray(j).iLayerName = ComboLayer.List(i) Then
Set Node2 = TreeView.Nodes.Add(Node1.Index, tvwChild, , CStr(M_pFeatureArray(j).iFeature.Value(0)))
End If
Next
If i = 0 Then
Node1.Expanded = True
End If
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid.Rows = M_pFeatureArray(0).iFeature.Fields.FieldCount + 10
For i = 0 To M_pFeatureArray(0).iFeature.Fields.FieldCount - 1
MSFlexGrid.TextMatrix(i + 1, 0) = M_pFeatureArray(0).iFeature.Fields.Field(i).AliasName
If M_pFeatureArray(0).iFeature.Fields.Field(i).Type = 7 Then
MSFlexGrid.TextMatrix(i + 1, 1) = ReturnGeometryName(M_pFeatureArray(0).iFeature.Shape.GeometryType)
Else
MSFlexGrid.TextMatrix(i + 1, 1) = CStr(M_pFeatureArray(0).iFeature.Value(i)) + ""
End If
Next i
Dim strXY As String
strXY = CStr(M_pFeatureArray(0).iFeature.Extent.xMin) + " " + CStr(M_pFeatureArray(0).iFeature.Extent.yMin)
TextCor.Text = "位置: (" + strXY + ")"
Dim pobjGeometry As IGeometry
Set pobjGeometry = M_pFeatureArray(0).iFeature.Shape
Dim pDisplay3D As IDisplay3D
If m_CheckOperate = isQuery Then
' Call FlashFeature(M_pFeatureArray(i).iFeature, frmMapControl.arcMapControl.ActiveView.FocusMap)
frmMapControl.arcMapControl.FlashShape pobjGeometry
ElseIf m_CheckOperate = iscls3dQuery Then
Set pDisplay3D = FrmMap3D.ArcSceneControl.Scene.SceneGraph
pDisplay3D.AddFlashFeature pobjGeometry
pDisplay3D.FlashFeatures
End If
' Show the nodes that are blChecked.
End Sub
Private Sub Form_Load()
' Me.Move (frmMain.Width - Me.Width), frmMain.Top
End Sub
Private Sub Form_Unload(cancel As Integer)
ReDim M_pFeatureArray(0)
End Sub
'输入:--调用ModFlash中的过程
'输出:目标flash
'功能:将点击的目标在地图上闪烁
'程序:tjh 2005.1.29
Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
Dim i As Long
Dim j As Long
Dim iLayerName As String
Dim ObjName As String
Dim pDisplay3D As IDisplay3D
On Error Resume Next
If Not Node.Parent Is Nothing Then
iLayerName = Node.Parent.Text
ObjName = Node.Text
For i = 0 To UBound(M_pFeatureArray) - 1
If iLayerName = M_pFeatureArray(i).iLayerName And ObjName = CStr(M_pFeatureArray(i).iFeature.Value(0)) Then
MSFlexGrid.Clear
MSFlexGrid.cols = 2
MSFlexGrid.ColAlignment(1) = flexAlignLeftCenter
MSFlexGrid.TextMatrix(0, 0) = "字段"
MSFlexGrid.ColWidth(0) = 1600
MSFlexGrid.ColWidth(1) = 2500
MSFlexGrid.TextMatrix(0, 1) = "值"
MSFlexGrid.Rows = M_pFeatureArray(i).iFeature.Fields.FieldCount + 10
For j = 0 To M_pFeatureArray(i).iFeature.Fields.FieldCount - 1
MSFlexGrid.TextMatrix(j + 1, 0) = M_pFeatureArray(i).iFeature.Fields.Field(j).AliasName
If M_pFeatureArray(i).iFeature.Fields.Field(j).Type = 7 Then
MSFlexGrid.TextMatrix(j + 1, 1) = ReturnGeometryName(M_pFeatureArray(i).iFeature.Shape.GeometryType)
Else
MSFlexGrid.TextMatrix(j + 1, 1) = M_pFeatureArray(i).iFeature.Value(j)
End If
Next j
Dim pobjGeometry As IGeometry
Set pobjGeometry = M_pFeatureArray(i).iFeature.Shape
If m_CheckOperate = isQuery Then
Call FlashFeature(M_pFeatureArray(i).iFeature, frmMapControl.arcMapControl.ActiveView.FocusMap)
ElseIf m_CheckOperate = iscls3dQuery Then
Set pDisplay3D = FrmMap3D.ArcSceneControl.Scene.SceneGraph
pDisplay3D.AddFlashFeature M_pFeatureArray(i).iFeature.Shape
pDisplay3D.FlashFeatures
End If
MSFlexGrid.TopRow = 1
Dim strXY As String
strXY = CStr(M_pFeatureArray(i).iFeature.Extent.xMin) + " " + CStr(M_pFeatureArray(i).iFeature.Extent.yMin)
TextCor.Text = "位置: (" + strXY + ")"
Exit For
End If
Next i
End If
End Sub
'输入:外部公共变量M_pFeatureArray
'输出:
'功能:将查询到的目标的属性和所属图层添加到treeview中
'程序:tjh 2005.1.29
Public Sub InitTreeView()
Dim i As Long, j As Long
Dim blCheck As Boolean
On Error Resume Next
TreeView.Nodes.Clear
For i = 0 To UBound(M_pFeatureArray) - 1
blCheck = False
For j = 0 To ComboLayer.ListCount
If M_pFeatureArray(i).iLayerName = ComboLayer.List(j) Then
blCheck = True
Exit For
End If
Next j
If blCheck = False Then
ComboLayer.AddItem M_pFeatureArray(i).iLayerName
End If
Next i
''''''''''''''''定制treeview树节点树'''''''''''''''''''''
MSFlexGrid.cols = 2
MSFlexGrid.ColAlignment(1) = flexAlignLeftCenter
MSFlexGrid.TextMatrix(0, 0) = "字段"
MSFlexGrid.ColWidth(0) = 1600
MSFlexGrid.ColWidth(1) = 2500
MSFlexGrid.TextMatrix(0, 1) = "值"
If UBound(M_pFeatureArray) = 0 Then Exit Sub
Dim Node1 As Node
Dim Node2 As Node
ComboLayer.Text = ComboLayer.List(0)
For i = 0 To ComboLayer.ListCount - 1
Set Node1 = TreeView.Nodes.Add(, , , ComboLayer.List(i))
For j = 0 To UBound(M_pFeatureArray) - 1
If M_pFeatureArray(j).iLayerName = ComboLayer.List(i) Then
Set Node2 = TreeView.Nodes.Add(Node1.Index, tvwChild, , CStr(M_pFeatureArray(j).iFeature.Value(0)))
End If
Next
If i = 0 Then
Node1.Expanded = True
End If
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid.Rows = M_pFeatureArray(0).iFeature.Fields.FieldCount + 10
For i = 0 To M_pFeatureArray(0).iFeature.Fields.FieldCount - 1
MSFlexGrid.TextMatrix(i + 1, 0) = M_pFeatureArray(0).iFeature.Fields.Field(i).AliasName
If M_pFeatureArray(0).iFeature.Fields.Field(i).Type = 7 Then
MSFlexGrid.TextMatrix(i + 1, 1) = ReturnGeometryName(M_pFeatureArray(0).iFeature.Shape.GeometryType)
Else
MSFlexGrid.TextMatrix(i + 1, 1) = CStr(M_pFeatureArray(0).iFeature.Value(i)) + ""
End If
Next i
Dim strXY As String
strXY = CStr(M_pFeatureArray(0).iFeature.Extent.xMin) + " " + CStr(M_pFeatureArray(0).iFeature.Extent.yMin)
TextCor.Text = "位置: (" + strXY + ")"
Dim pobjGeometry As IGeometry
Set pobjGeometry = M_pFeatureArray(0).iFeature.Shape
Dim pDisplay3D As IDisplay3D
If m_CheckOperate = isQuery Then
' Call FlashFeature(M_pFeatureArray(i).iFeature, frmMapControl.arcMapControl.ActiveView.FocusMap)
frmMapControl.arcMapControl.FlashShape pobjGeometry
ElseIf m_CheckOperate = iscls3dQuery Then
Set pDisplay3D = FrmMap3D.ArcSceneControl.Scene.SceneGraph
pDisplay3D.AddFlashFeature pobjGeometry
pDisplay3D.FlashFeatures
End If
' Show the nodes that are blChecked.
End Sub
Private Sub Form_Load()
' Me.Move (frmMain.Width - Me.Width), frmMain.Top
End Sub
Private Sub Form_Unload(cancel As Integer)
ReDim M_pFeatureArray(0)
End Sub
'输入:--调用ModFlash中的过程
'输出:目标flash
'功能:将点击的目标在地图上闪烁
'程序:tjh 2005.1.29
Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
Dim i As Long
Dim j As Long
Dim iLayerName As String
Dim ObjName As String
Dim pDisplay3D As IDisplay3D
On Error Resume Next
If Not Node.Parent Is Nothing Then
iLayerName = Node.Parent.Text
ObjName = Node.Text
For i = 0 To UBound(M_pFeatureArray) - 1
If iLayerName = M_pFeatureArray(i).iLayerName And ObjName = CStr(M_pFeatureArray(i).iFeature.Value(0)) Then
MSFlexGrid.Clear
MSFlexGrid.cols = 2
MSFlexGrid.ColAlignment(1) = flexAlignLeftCenter
MSFlexGrid.TextMatrix(0, 0) = "字段"
MSFlexGrid.ColWidth(0) = 1600
MSFlexGrid.ColWidth(1) = 2500
MSFlexGrid.TextMatrix(0, 1) = "值"
MSFlexGrid.Rows = M_pFeatureArray(i).iFeature.Fields.FieldCount + 10
For j = 0 To M_pFeatureArray(i).iFeature.Fields.FieldCount - 1
MSFlexGrid.TextMatrix(j + 1, 0) = M_pFeatureArray(i).iFeature.Fields.Field(j).AliasName
If M_pFeatureArray(i).iFeature.Fields.Field(j).Type = 7 Then
MSFlexGrid.TextMatrix(j + 1, 1) = ReturnGeometryName(M_pFeatureArray(i).iFeature.Shape.GeometryType)
Else
MSFlexGrid.TextMatrix(j + 1, 1) = M_pFeatureArray(i).iFeature.Value(j)
End If
Next j
Dim pobjGeometry As IGeometry
Set pobjGeometry = M_pFeatureArray(i).iFeature.Shape
If m_CheckOperate = isQuery Then
Call FlashFeature(M_pFeatureArray(i).iFeature, frmMapControl.arcMapControl.ActiveView.FocusMap)
ElseIf m_CheckOperate = iscls3dQuery Then
Set pDisplay3D = FrmMap3D.ArcSceneControl.Scene.SceneGraph
pDisplay3D.AddFlashFeature M_pFeatureArray(i).iFeature.Shape
pDisplay3D.FlashFeatures
End If
MSFlexGrid.TopRow = 1
Dim strXY As String
strXY = CStr(M_pFeatureArray(i).iFeature.Extent.xMin) + " " + CStr(M_pFeatureArray(i).iFeature.Extent.yMin)
TextCor.Text = "位置: (" + strXY + ")"
Exit For
End If
Next i
End If
End Sub
