IPolygonMovePointFeedback の利用

' 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