Source code of 3D query based on AE

Source code of 3D query based on 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

'Input: Current 3D map, X coordinate, Y coordinate, reference public variable m_pfeaturearray
'Output: select the target on the 3D map. Call frmidentify to display the information of the selected target.
'Function: single-point Query
'Program: 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 frmidenible. Visible = false then
Frmidentify. Show 0
End if
Frmidentify. setfocus
Call frmidenview. inittreeview
End subprivate m_hwndtv as long
'Input: External Public variable m_pfeaturearray
'Output:
'Function: add the attributes and layers of the target to the Treeview.
'Program: 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
End if
Next J
If blcheck = false then
Combolayer. additem m_pfeaturearray (I). ilayername
End if
Next I

''''' ''' Customizes the Treeview Tree node tree '''''''''''''''''''''
Msflexgrid. Cols = 2
Msflexgrid. colalignment (1) = flexalignleftcenter
Msflexgrid. textmatrix (0, 0) = "field"
Msflexgrid. colwidth (0) = 1600
Msflexgrid. colwidth (1) = 2500
Msflexgrid. textmatrix (0, 1) = "value"
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 = "Location: (" + 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

'Input: -- call the modflash Process
'Output: Target flash
'Function: flashes the clicked target on the map.
'Program: 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) = "field"
Msflexgrid. colwidth (0) = 1600
Msflexgrid. colwidth (1) = 2500
Msflexgrid. textmatrix (0, 1) = "value"
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 = "Location: (" + strxy + ")"
Exit
End if
Next I
End if
End sub