フィーチャの移動

'ArcMapで編集セッションを有効にして移動対象のフィーチャを選択しておく
'http://edndoc.esri.com/arcobjects/8.3/Samples/Editing/MoveFeatures.htm
Public Sub MoveFeatures()
  Dim pEditor As IEditor
  Dim pEndPoint As IPoint
  Dim pEnumFeature As IEnumFeature
  Dim pFeature As IFeature
  Dim pFeatureEdit As IFeatureEdit
  Dim pID As New UID
  Dim pInvalidArea As IInvalidArea
  Dim pLine As ILine
  Dim pMoveSet As ISet
  Dim pSpatialReference As ISpatialReference
  Dim pStartPoint As IPoint
   
  Dim origX As Double
  Dim origY As Double
  Dim Count As Integer
  Dim bInOperation As Boolean
   
  On Error GoTo ErrorHandler
 
  'Get a reference to the editor extension
  pID = "esriCore.Editor"
  Set pEditor = Application.FindExtensionByCLSID(pID)
 
  'Create an edit operation enabling undo for the operation
  pEditor.StartOperation
  bInOperation = True
   
  'Make sure something has been selected
  If pEditor.SelectionCount = 0 Then Exit Sub
 
  'Add all the editor's selected features to a new set
  Set pEnumFeature = pEditor.EditSelection
   
'  'Flag those areas of the display that need refreshing
'  Set pInvalidArea = New InvalidArea
'  Set pInvalidArea.Display = pEditor.Display
'  pInvalidArea.Add pEnumFeature
 
  Set pMoveSet = New esriSystem.Set
  pEnumFeature.Reset
  For Count = 0 To pEditor.SelectionCount - 1
    Set pFeature = pEnumFeature.Next
    pMoveSet.Add pFeature
  Next Count
     
  'Reset the Set
  pMoveSet.Reset
     
  'MoveSet requires a line to specify the new location'Use the selection anchor as a starting point for the line
  Set pStartPoint = pEditor.SelectionAnchor.Point
  Set pLine = New Line
  pStartPoint.QueryCoords origX, origY
  Set pEndPoint = New Point
  pEndPoint.PutCoords (origX + 1050), (origY + 0) 'offset the selection by 50 units in the x direction
  pLine.PutCoords pStartPoint, pEndPoint
     
  'Get the spatial reference from the map and assign it to the new line
  Set pSpatialReference = pEditor.Map.SpatialReference
  Set pLine.SpatialReference = pSpatialReference 'Set the spatial reference of the new line'Do the move while looping through the set
  Set pFeatureEdit = pMoveSet.Next
  Do While Not pFeatureEdit Is Nothing
    pFeatureEdit.MoveSet pMoveSet, pLine  'Move all the selected features 50 units to the right
    Set pFeatureEdit = pMoveSet.Next
  Loop
     
  'Stop the Edit Operation
  pEditor.StopOperation "Move Selection"
  bInOperation = False
   
  Dim pMxDocument As IMxDocument
  Set pMxDocument = ThisDocument
  pMxDocument.ActiveView.Refresh
   
   
'  pInvalidArea.Invalidate esriAllScreenCaches
   
  'Additionally move the selection anchor
  pEditor.SelectionAnchor.MoveTo pEndPoint, pEditor.Display
   
  Exit Sub
   
ErrorHandler:
  If bInOperation Then
    pEditor.AbortOperation
    MsgBox "Error moving features.  Check selected features for topological associations."
  End If
  
End Sub