• ポイント･レイヤが選択されている場合、X_COORDとYCOORDという名前のフィールドを追加し、フィーチャのX,Y座標が格納されます。
  
  
• ライン･レイヤが選択されている場合、MID_XとMID_Yという名前のフィールドを追加し、各ラインの中間点の座標が格納されます。
  
  
• ポリゴン･レイヤが選択されている場合、CENTROID_XとCENTROID_Yという名前のフィールドを追加し、各ポリゴンの重心座標が格納されます。

1. ArcMapを開きます。
   
   
2. 新規UIButtonControlを作成します。
   
   
3. UIButtonControlを右クリックし、[ソースの表示]を選択します。
   
   
4. 以下のコードをペーストします。
   

Option Explicit
Dim X_Pos As Integer
Dim Y_Pos As Integer
Dim fClass As IFeatureClass






Private Sub UIButtonControl1_Click()
  ' シェープファイル、カバレッジ、ジオデータベースフィーチャクラスのテーブルに
  ' 座標情報を追加します。
  Dim mxDoc As IMxDocument
  Dim selectedLayer As ILayer
  Dim fLayer As IFeatureLayer

  Set mxDoc = ThisDocument
  Set selectedLayer = mxDoc.selectedLayer
  If selectedLayer Is Nothing Then
    MsgBox "TOCからレイヤを選択してください。", vbCritical, "レイヤが選択されていません"
    Exit Sub
  End If
  If Not TypeOf selectedLayer Is IFeatureLayer Then
    MsgBox "TOCからフィーチャレイヤを選択してください。", _
      vbCritical, "選択されたレイヤはフィーチャレイヤではありません"
    Exit Sub
  End If
  Set fLayer = selectedLayer
  Set fClass = fLayer.FeatureClass
  Select Case fClass.ShapeType
    Case esriGeometryPoint
      If AddFields("X_Coord", "Y_Coord") = True Then
        AddXY_Points
      End If
    Case esriGeometryPolyline
      If AddFields("Mid_X", "Mid_Y") = True Then
        AddXY_Lines ' ラインの中点を求めます。
      End If
    Case esriGeometryPolygon
      If AddFields("Centroid_X", "Centroid_Y") = True Then
        AddXY_Polygons ' ポリゴンの重心を求めます。
      End If
    Case Else
      MsgBox "このツールはポイント、ライン、ポリゴンでのみ動作します。", _
        vbCritical, "サポートされていないジオメトリ･タイプ"
      Exit Sub
  End Select
End Sub

Private Function AddFields(fieldName1 As String, fieldName2 As String) As Boolean
  ' 座標情報を格納するフィールドを追加します。
  On Error GoTo couldntAddFields
  Dim newField As IFieldEdit

  ' すでに同じ名前のフィールドが存在している場合、削除します。
  If fClass.FindField(fieldName1) <> -1 Then
    fClass.DeleteField fClass.Fields.Field(fClass.FindField(fieldName1))
  End If

  ' フィールドを作成します。
  Set newField = New esriCore.Field
  With newField
    .Name = fieldName1
    .Type = esriFieldTypeDouble
  End With
  fClass.AddField newField

  ' 


すでに同じ名前のフィールドが存在している場合、削除します。



  If fClass.FindField(fieldName2) <> -1 Then
    fClass.DeleteField fClass.Fields.Field(fClass.FindField(fieldName2))
  End If

  ' 


フィールドを作成します。



  Set newField = New esriCore.Field
  With newField
    .Name = fieldName2
    .Type = esriFieldTypeDouble
  End With
  fClass.AddField newField
  X_Pos = fClass.FindField(fieldName1)
  Y_Pos = fClass.FindField(fieldName2)
  If X_Pos = -1 Or Y_Pos = -1 Then
    GoTo couldntAddFields
  End If
  AddFields = True
  Exit Function

couldntAddFields:
  MsgBox Err.Description & Chr(13) & "AddXYは完了しませんでした", _
    vbCritical, "フィールドを追加することができませんでした"
  AddFields = False
End Function

Private Sub AddXY_Points()
  ' 各ポイントのX,Y座標を取得します。
  Dim fCursor As IFeatureCursor
  Dim aFeature As IFeature
  Dim thePoint As IPoint

  Set fCursor = fClass.Update(Nothing, False)
  Set aFeature = fCursor.NextFeature
  Do Until aFeature Is Nothing
    Set thePoint = aFeature.Shape
    aFeature.Value(X_Pos) = thePoint.X
    aFeature.Value(Y_Pos) = thePoint.Y
    fCursor.UpdateFeature aFeature
    Set aFeature = fCursor.NextFeature
  Loop
End Sub

Private Sub AddXY_Lines()
  ' 各ラインの中点のX,Y座標を取得します。
  Dim fCursor As IFeatureCursor
  Dim aFeature As IFeature
  Dim theCurve As ICurve
  Dim thePoint As IPoint

  Set thePoint = New esriCore.Point
  Set fCursor = fClass.Update(Nothing, False)
  Set aFeature = fCursor.NextFeature
  Do Until aFeature Is Nothing
    Set theCurve = aFeature.Shape
    theCurve.QueryPoint 0, 0.5, True, thePoint
    aFeature.Value(X_Pos) = thePoint.X
    aFeature.Value(Y_Pos) = thePoint.Y
    fCursor.UpdateFeature aFeature
    Set aFeature = fCursor.NextFeature
  Loop
End Sub

Private Sub AddXY_Polygons()
  ' 各ポリゴンの重心のX,Y座標を取得します。
  Dim fCursor As IFeatureCursor
  Dim aFeature As IFeature
  Dim thePolygon As IArea
  Dim thePoint As IPoint

  Set fCursor = fClass.Update(Nothing, False)
  Set aFeature = fCursor.NextFeature
  Do Until aFeature Is Nothing
    Set thePolygon = aFeature.Shape
    Set thePoint = thePolygon.Centroid
    aFeature.Value(X_Pos) = thePoint.X
    aFeature.Value(Y_Pos) = thePoint.Y
    fCursor.UpdateFeature aFeature
    Set aFeature = fCursor.NextFeature
  Loop
End Sub