基于AE的三维查询源代码

楼主^#

更多发布于：2007-05-17 18:49

基于AE的三维查询源代码 
<DIV >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</DIV>

喜欢0 评分0

举报回复

alearner

路人甲

注册日期2006-09-11
发帖数74
QQ
铜币433枚
威望0点
贡献值0点
银元0个

加关注写私信

1楼^#

发布于：2007-05-17 18:49

<DIV 12px">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</DIV>

举报回复喜欢评分

cl991036

管理员

注册日期2003-07-25
发帖数5917
QQ14265545
铜币29669枚
威望217点
贡献值0点
银元0个

加关注写私信

2楼^#

发布于：2007-05-18 00:40

没钱又丑，农村户口。头可断，发型一定不能乱。邮箱:gisempire@qq.com

举报回复喜欢评分

whmwxhanshan123 路人甲注册日期2006-06-17 发帖数3108 QQ 铜币6445枚威望0点贡献值0点银元0个加关注写私信	3楼^# 发布于：2007-05-20 19:41 没钱又丑<img src="images/post/smile/dvbbs/em01.gif" />
	举报回复(0) 喜欢(0) 评分

您需要登录后才可以回帖，登录或者注册

基于AE的三维查询源代码

最新喜欢：