YouTube | Facebook | X(Twitter) | RSS


2016/9/1 (木)

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
  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
  For Count = 0 To pEditor.SelectionCount - 1
    Set pFeature = pEnumFeature.Next
    pMoveSet.Add pFeature
  Next Count
  'Reset the Set
  '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
  'Stop the Edit Operation
  pEditor.StopOperation "Move Selection"
  bInOperation = False
  Dim pMxDocument As IMxDocument
  Set pMxDocument = ThisDocument
'  pInvalidArea.Invalidate esriAllScreenCaches
  'Additionally move the selection anchor
  pEditor.SelectionAnchor.MoveTo pEndPoint, pEditor.Display
  Exit Sub
  If bInOperation Then
    MsgBox "Error moving features.  Check selected features for topological associations."
  End If
End Sub
  • この記事を書いた人

羽田 康祐

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

-プログラミング, ArcGIS