Dim pSXDoc As ISxDocument
Set pSXDoc = ThisDocument
Dim pSG As ISceneGraph
Set pSG = pSXDoc.Scene.SceneGraph

Dim pGLayer As IGraphicsLayer
Set pGLayer = pSXDoc.Scene.ActiveGraphicsLayer

Dim pGC As IGraphicsContainer3D
Set pGC = pGLayer

Dim pHits As IHit3DSet
pSG.LocateMultiple pSG.ActiveViewer, x, y, esriScenePickAll, True, pHits
If pHits Is Nothing Then
　MsgBox "No hits were returned."
　Exit Sub
End If

Dim i As Integer
Dim pHit As IHit3D

For i = 0 To pHits.Hits.Count - 1
　Set pHit = pHits.Hits.Element(i)
　With pHit
　　If TypeOf .Owner Is ILayer Then
　　　Dim player As ILayer
　　　Set player = .Owner
　　End If
   
　　If Not .Object Is Nothing Then
　　　If TypeOf .Object Is IFeature Then
　　　　Dim pFeature As IFeature
　　　　Set pFeature = .Object
　　　End If
　　End If

　　Debug.Print " Geographic location: " & .Point.x & ", " & .Point.y & ", " & .Point.z

　　AddElem pFeature, .Point.x, .Point.y, .Point.z, pGC, player
　End With
Next
   
pSXDoc.Scene.SceneGraph.RefreshViewers

Sub AddElem(pFeature As IFeature, x As Double, y As Double, z As Double, _
　　　　　　　　　pGC As IGraphicsContainer3D, player As IFeatureLayer)

　Dim pPt As IPoint
　Dim pPoly As IPolygon
　Dim pArea As IArea
　Dim p3DElem As IText3DElement

　Set pPoly = pFeature.Shape
　Set pPt = New Point
　pPt.PutCoords x, y
　pPt.z = 0

　Dim pEnv As IEnvelope
　Set pEnv = pPoly.Envelope

　Set p3DElem = New Text3DElement
　With p3DElem
　　.Text = pFeature.Value(pFeature.Fields.FindField(player.DisplayField))
　　.Height = pPoly.Envelope.Height / 20
　　.Depth = pPoly.Envelope.Height / 40
　　.ZAxisScale = 1
　　.Alignment = esriT3DAlignHorizontal
　　.OrientationPlane = esriT3DPlaneXZ
　　.Justification = esriT3DJustifyCenter
　　.AxisRotation = esriT3DRotateAxisZ
　　.RotationAngle = 0
　　.BoldFont = True
　　.FONTNAME = "MS UI Gothic"
　　.AnchorPoint = pPt
　End With

　p3DElem.Update

　pGC.AddElement p3DElem




End Sub