原理是差不多的,接口有点不同了,下面的例子你可以看看
\'Identifies point in scene using x,y coordinates and returns ID of selected point
\'The function was used by taking the x/y coordinates from the Scen1_OnMouseDown
event and passing into the functrion as newY and newY
Public Function IdentifyPointXY(newX As Double, newY As Double) As Double
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pIdentify As IIdentify
Dim pPoint As IPoint
Dim pEnvelope As IEnvelope
Dim pIDArray As IArray
Dim pIdObj As IIdentifyObj
Dim pFeatIdObj As IFeatureIdentifyObj
Dim pRowObj As IRowIdentifyObject
Dim pIdentifyDialog As IIdentifyDialog
Dim pLayer As ILayer
Dim pFeature As IFeature
Set pLayer = MainForm.Scene1.SceneGraph.Scene.Layer(0)
Set pScene = MainForm.Scene1.SceneGraph.Scene
\'Identify a shapefile point
If TypeOf pLayer Is IFeatureLayer Then
Set pIdentify = pLayer \'topmost layer
Set pPoint = New Point
pPoint.PutCoords newX, newY
Set pEnvelope = pPoint.Envelope
pEnvelope.Expand 0.01, 0.01, False
Set pIDArray = pIdentify.Identify(pEnvelope)
\'Get the FeatureIdentifyObject
If Not pIDArray Is Nothing Then
\'tempLength = pIDArray.Element(0)
Set pFeatIdObj = pIDArray.Element(0)
a = pIDArray.Count
\'Form1.Text4.Text = CStr(tempLength)
Set pIdObj = pFeatIdObj
\'Set pIdObj = pIDArray.Count
Set pRowObj = pFeatIdObj
Set pFeature = pRowObj.Row
\'MainForm.SceneIDText.Text = CStr(pFeature.OID)
Set pScene = MainForm.Scene1.SceneGraph.Scene
Dim pGeom As IGeometry
Set pGeom = pFeature.Shape
Dim bJustOne As Boolean
pScene.SelectByShape pGeom, Nothing, bJustOne
\'Output ID of selected feature
IdentifyPointXY = pFeature.OID
Else
MsgBox "No feature identified.", vbCritical
\'Stop
End If
\'Identify a raster point
ElseIf TypeOf pLayer Is IRasterLayer Then
\'
Dim pRLayer As IRasterLayer
Set pRLayer = pLayer
Dim pSurf As IRasterSurface
Dim p3DProp As I3DProperties
Dim pLE As ILayerExtensions
Set pLE = pLayer
Dim i As Integer
\'look for 3D properties of layer:
For i = 0 To pLE.ExtensionCount - 1
If TypeOf pLE.Extension(i) Is I3DProperties Then
Set p3DProp = pLE.Extension(i)
Exit For
End If
Next
\'look first for base surface of layer:


Set pSurf = p3DProp.BaseSurface
\'look first for base surface of layer:
Set pSurf = p3DProp.BaseSurface
\'if not found, try first band of raster:
If pSurf Is Nothing Then
Exit Function
End If
Dim nSurf As ISurface
Set nSurf = pSurf
Dim nDoub As Double
\'Create point to feed into GetElevation
Dim getElevationPoint As IPoint
Set getElevationPoint = New Point
getElevationPoint.X = newX
getElevationPoint.Y = newY
IdentifyPointXY = nSurf.GetElevation(getElevationPoint)
End If
End Function
--------------------------------------------------------------------------------
-- 作者：浪花闪闪
-- 发布时间：2006-1-18 21:33:39
--
谢谢总统先生!
--------------------------------------------------------------------------------
-- 作者：JIALAN
-- 发布时间：2006-2-18 10:26:13
--
这个还不全啊 还有ITinLayer都没有做判断 而且RasterLayer的语句里面也有不对的， \'if not found, try first band of raster:
If pSurf Is Nothing Then
Exit Function
End If
在判断出pSurf 为空时不能直接退出，应该if(pRSurf==null)
{
if(pRLayer.Raster!=null)
{
pSurf =new RasterSurfaceClass();
pBands = (IRasterBandCollection)pRLayer.Raster;
pRSurf.RasterBand = pBands.Item(0);
}
}才完善
--------------------------------------------------------------------------------
-- 作者：gis
-- 发布时间：2006-2-18 18:44:30
--
楼上所言极是
偶只是给楼主一个思路
请参考:
'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