'ArcSceneによるクリック地点のポイント座標取得 Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim pSxDocument As ISxDocument Set pSxDocument = ThisDocument Dim pSceneGraph As ISceneGraph Set pSceneGraph = pSxDocument.Scene.SceneGraph 'マウスクリックして取得できる最短のフィーチャを対象 Dim pPoint As IPoint pSceneGraph.Locate pSceneGraph.ActiveViewer, x, y, esriScenePickAll, True, pPoint, Nothing, Nothing Debug.Print pPoint.x, pPoint.y, pPoint.Z '複数のレイヤを対象 Dim pHit3DSet As IHit3DSet pSceneGraph.LocateMultiple pSceneGraph.ActiveViewer, x, y, esriScenePickAll, True, pHit3DSet If pHits Is Nothing Then MsgBox "ヒットしませんでした" Exit Sub End If Debug.Print "取得したフィーチャ数:" & pHit3DSet.Hits.Count End Sub 'ArcGlobeによるクリック地点のポイント座標取得 Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long) Dim pGMxDocument As IGMxDocument Set pGMxDocument = ThisDocument Dim pGlobe As IGlobe Set pGlobe = pGMxDocument.Scene Dim pGlobeDisplay As IGlobeDisplay Set pGlobeDisplay = pGlobe.GlobeDisplay 'マウスクリックして取得できる最短のフィーチャを対象 Dim pPoint As IPoint pGlobeDisplay.Locate pGlobeDisplay.ActiveViewer, x, y, False, True, pPoint, Nothing, Nothing Dim dblHeight As Double pGlobeDisplay.GetSurfaceElevation pPoint.x, pPoint.y, True, dblHeight Debug.Print pPoint.x, pPoint.y, dblHeight End Sub
ArcScene と ArcGlobe によるクリック地点のポイント座標取得
2016/9/1 (木)