YouTube | Facebook | X(Twitter) | RSS

IPolygonMovePointFeedback の利用

2016/9/1 (木)

' ArcMapのVBAでUIToolControlを作成し、ポリゴン エレメントに対して操作
' http://resources.esri.com/help/9.3/ArcGISEngine/arcobjects/esriDisplay/IPolygonMovePointFeedback_Example.htm
 
Option Explicit
 
Private m_pDoc As IMxDocument
Private m_pAV As IActiveView
Private m_pScrD As IScreenDisplay
Private m_pPolyMvPtFeed As IPolygonMovePointFeedback
Private m_pHitElem As IElement
Private m_pGraCont As IGraphicsContainer
 
Private Function UIToolControl1_Enabled() As Boolean
  'Set the ToolControl to enabled (disabled by default)
  UIToolControl1_Enabled = True
End Function
 
Public Function GetHitElement(pInPt As IPoint, DblSrchDis As Double) As IElement
' Takes an IPoint and returns the first element that is hit (if any) in the ActiveView's BasicGraphicsLayer
  Dim pEnumElem As IEnumElement
  Dim pElemCur As IElement
   
  ' QI for the IGraphicsContainer interface from the IActiveView, allows access to the BasicGraphicsLayer
  Set m_pGraCont = m_pAV
   
  ' Return an enumerator for those elements found within the search distance (in mapunits)
  Set pEnumElem = m_pGraCont.LocateElements(pInPt, DblSrchDis)
   
  ' If the enumerator is not empty then return the FIRST element found
  If Not pEnumElem Is Nothing Then
    Set pElemCur = pEnumElem.Next
    Do While Not pElemCur Is Nothing
      If pElemCur.Geometry.GeometryType = esriGeometryPolygon Then
         Set GetHitElement = pElemCur
         Exit Do
      End If
      Set pElemCur = pEnumElem.Next
    Loop
  End If
End Function
 
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  Dim pPnt As IPoint
  Dim pGeomPoly As IPolygon
  Dim pHtTest As IHitTest
  Dim pPtHit As IPoint
  Dim DblHitDis As Double
  Dim LngPrtIdx As Long
  Dim LngSegIdx As Long
  Dim BoolHitRt As Boolean
  Dim BoolHitTest As Boolean
  Dim DblSrchDis As Double
   
   
  ' Calculate the Search Distance (in MapUnits) based upon a portion of the ActiveView's width
  DblSrchDis = m_pAV.Extent.Width / 200  ' Get the current mouse location in Map Units
   
  Set pPnt = m_pScrD.DisplayTransformation.ToMapPoint(x, y)
  ' Use a function to return the first element of the correct geometry type at this point (if any)
  Set m_pHitElem = GetHitElement(pPnt, DblSrchDis)
   
  ' If a Polygon element was returned then check if a vertex was hit
  If Not m_pHitElem Is Nothing Then
    ' Get the element's geometry (Polygon)
    Set pGeomPoly = m_pHitElem.Geometry
    ' QI for the IHitTest Interface (to get check which if any vertex was hit)
    Set pHtTest = pGeomPoly
     
    'Check which (if any) vertex was hit
    'ByVal: pPnt - input userpoint; DblSrchDis - searchdist (mapunits); esriGeometryPartVertex - look for vertices;
    'ByRef: pPtHit - intersection point; DblHitDis - dist between vertex and pPnt; LngPrtIdx - part index; LngSegIdx - vertex index; BoolHitRt - is pPnt right of Polygon
    BoolHitTest = pHtTest.HitTest(pPnt, DblSrchDis, esriGeometryPartVertex, pPtHit, DblHitDis, LngPrtIdx, LngSegIdx, BoolHitRt)
     
    If BoolHitTest Then
        ' Create a PolygonMovePointFeedback object and set its display property (to the ActiveView's ScreenDisplay)
        Set m_pPolyMvPtFeed = New PolygonMovePointFeedback
        Set m_pPolyMvPtFeed.Display = m_pScrD
         
        'Start the feedback using the input (Polygon) geometry at the current mouse location
        m_pPolyMvPtFeed.Start pGeomPoly, LngSegIdx, pPnt
    End If
  End If
End Sub
 
Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  If Not m_pPolyMvPtFeed Is Nothing Then
     
    Dim pPnt As IPoint
    ' Get the current mouse location in Map Units and move the feedback
    Set pPnt = m_pScrD.DisplayTransformation.ToMapPoint(x, y)
    m_pPolyMvPtFeed.MoveTo pPnt
  End If
End Sub
 
Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  Dim pPolyResult As IPolygon
  ' Check that the user is using the feedback
  If Not m_pPolyMvPtFeed Is Nothing Then
    ' Get the result from the feedback
    Set pPolyResult = m_pPolyMvPtFeed.Stop
     
    ' Check for a valid result
    If Not pPolyResult Is Nothing Then
      ' Set the geometry of the element and call update
      m_pHitElem.Geometry = pPolyResult
      m_pGraCont.UpdateElement m_pHitElem
    End If
     
    ' Clear out the objects
    Set m_pPolyMvPtFeed = Nothing
    Set m_pHitElem = Nothing
     
     
    ' Refresh the ActiveView
    m_pAV.Refresh
  End If
End Sub
 
Private Sub UIToolControl1_Refresh(ByVal hDC As Long)
  'Get a reference to the ActiveView and ScreenDisplay
  Set m_pDoc = Application.Document
  Set m_pAV = m_pDoc.ActiveView
  Set m_pScrD = m_pAV.ScreenDisplay
End Sub
 
Private Sub UIToolControl1_Select()
  'Get a reference to the ActiveView and ScreenDisplay
  Set m_pDoc = Application.Document
  Set m_pAV = m_pDoc.ActiveView
  Set m_pScrD = m_pAV.ScreenDisplay
End Sub
  • この記事を書いた人

羽田 康祐

伊達と酔狂のGISエンジニア。GIS上級技術者、Esri認定インストラクター、CompTIA CTT+ Classroom Trainer、潜水士、PADIダイブマスター、四アマ。WordPress は 2.1 からのユーザーで歴だけは長い。 代表著書『"地図リテラシー入門―地図の正しい読み方・描き方がわかる』 GIS を使った自己紹介はこちら。ESRIジャパン(株)所属、元青山学院大学非常勤講師を兼務。日本地図学会第31期常任委員。発言は個人の見解です。

-プログラミング, ArcGIS
-,