[ArcObjects] Feature를 X, Y Offset만큼 이동하는 VBA 스크립트

▣ 미션
 - ArcGIS를 사용하여 아래 그림과 같이 레이어의 모든 피쳐를 X 축의 방향으로 dX 만큼, Y 축의 방향으로 dY 만큼 이동하고 싶습니다.


▣ ArcObjects ITransform2D.Move Method

[이미지출처: http://help.arcgis.com/en/sdk/10.0/arcobjects_net/componenthelp/index.html#/Move_Method/002m000003w4000000/]

▣ VBA Script
 - Feature의 Geometry를 X, Y Offset만큼 이동
 - Undo/Redo가 가능하도록 Editor를 사용
 - 따라서 정상적으로 편집이 되었을 경우 Editor 툴바에서 저장할 것

Option Explicit

Sub MoveGeometry()
    ' get map
    Dim ipDoc As IMxDocument
    Dim focusMap As IMap
    
    Set ipDoc = ThisDocument
    Set focusMap = ipDoc.focusMap
        
    ' get featurelayer
    Dim featureLayer As IFeatureLayer
    Set featureLayer = focusMap.Layer(0)
    ' start editing
    Dim pID As New esriSystem.UID
    pID.Value = "esriEditor.Editor"
        
    Dim editor As IEditor
    Set editor = Application.FindExtensionByCLSID(pID)
    If (editor.EditState <> esriStateEditing) Then
        Dim dataset As IDataset
        Set dataset = featureLayer
        editor.StartEditing dataset.Workspace
    End If
    
    ' start edit operation
    editor.StartOperation
               
    ' set parameters
    Dim dX As Double, dY As Double    
    dX = 5000 ' map unit
    dY = 5000 ' map unit
     
    Dim totalCnt As Long, step As Long
    Dim featureCursor As IFeatureCursor, feature As IFeature, geometry As IGeometry
    
    totalCnt = featureLayer.featureClass.FeatureCount(Nothing)
    Set featureCursor = featureLayer.Search(Nothing, False)
    Set feature = featureCursor.NextFeature
    Do Until feature Is Nothing
        DoEvents
        step = step + 1
        Application.StatusBar.Message(0) = step & " / " & totalCnt & " processed..."
        
        Set geometry = feature.ShapeCopy
        
        ' moves the geometry dX units along the X-Axis and dY units along the Y-Axis
        Dim transform2D  As ITransform2D
        Set transform2D = geometry
        transform2D.Move dX, dY
        
        ' update geometry
        Set feature.Shape = transform2D
        feature.Store
        
        Set feature = featureCursor.NextFeature
    Loop
    
    ' cleanup
    Set featureCursor = Nothing
    
    ' stop edit operation
    editor.StopOperation featureLayer.Name & " Move Operation"
    
    ' refresh map
    Dim activeView As IActiveView
    Set activeView = focusMap
    activeView.Refresh
    
    MsgBox "지도 확인 후 Editor 툴바에서 저장해야 합니다."
End Sub

▣ 실행결과