[ArcGIS]지적도 토지코드 분리 VBA Script

일반적으로 KLIS 지적도의 속성에는 토지코드(PNU), 지번(JIBUN) 이 있습니다.

토지코드(PNU)는 19자리의 숫자로 구성되어 있으며 각각의 의미는 다음과 같습니다.
 - 시도(2)+시군구(3)+읍면동(3)+리(2)+토지구분1(1)+본번(4)+부번(4)
 - 2720010200106040023(대구광역시 남구 봉덕동 604-23 번지)
지번(JIBUN)은 본번-부번 지목(551-27 대)으로 구성됩니다.

ArcGIS 9.4버전부터는 VBA를 버리고 Python으로 대체한다고 들었습니다만, 현재까지는 가장 유용하게 사용할 수 있는 도구가 VBA입니다.

여기에서는 ArcMap에 지적도(편집/연속지적)를 추가한 후  행정코드(DONG_CODE, 10자리), 산구분(SAN, 1자리), 번지(BONBUN, 4자리), 호(BUBN, 4자리), 지목(JIMOK, 2자리), 필지중심점X(CX, Double), 필지중심점Y(CY, Double) 필드를 추가한 후 각 속성을 계산하는 스크립트입니다.

피쳐 유형은 폴리곤/포인트 모두 사용 가능합니다.

▣ 전제사항
 - ArcMap에 지적도 레이어가 추가되어 있고 이름은 "지적도"일것
 - 지적도에는 19자리의 PNU와 지번(마지막은 지목) 필드를 포함할 것
 - 레이어는 Shapefile, Personal GDB(mdb), File GDB일것
 - 스크립트 실행 조건은 편집 상태가 아닐것(Update Cursor를 사용하기 때문임)

▣ 메인 코드

펼쳐두기..

[code vb]
Option Explicit
Private m_ipMap As IMap
'============================================================
'    title : 지적도 지번 및 지목 추출
'============================================================
Public Sub SplitParcelAttriute()
    Dim ipDoc As IMxDocument
    Set ipDoc = ThisDocument
   
    Set m_ipMap = ipDoc.FocusMap

    Dim ipFeatureLayer As IFeatureLayer
    Dim ipFeatureClass As IFeatureClass
   
    Set ipFeatureLayer = GetFeatureLayer(m_ipMap, "지적도")
    If (ipFeatureLayer Is Nothing) Then
        MsgBox "레이어가 없습니다.확인 바랍니다."
        Exit Sub
    End If
   
    Set ipFeatureClass = ipFeatureLayer.FeatureClass
        
    Dim idxPnu As Long, idxJibun As Long
    idxPnu = ipFeatureClass.FindField("PNU")
    idxJibun = ipFeatureClass.FindField("JIBUN")
   
    If (idxPnu = -1 Or idxJibun = -1) Then
        MsgBox "PNU 또는 JIBUN 필드가 없습니다.확인 바랍니다."
        Exit Sub
    End If
       
    '1. 필드 확인 및 추가 : 필드가 없으면 추가함
    AddField ipFeatureClass, "DONG_CODE", esriFieldTypeString, 10, "동코드"
    AddField ipFeatureClass, "SAN", esriFieldTypeString, 1, "산구분"
    AddField ipFeatureClass, "BONBUN", esriFieldTypeString, 4, "번지"
    AddField ipFeatureClass, "BUBUN", esriFieldTypeString, 4, "호"
    AddField ipFeatureClass, "JIMOK", esriFieldTypeString, 2, "지목"
    AddField ipFeatureClass, "CX", esriFieldTypeDouble, 38, "X좌표"
    AddField ipFeatureClass, "CY", esriFieldTypeDouble, 38, "Y좌표"
   
    '2. 계산
    Dim totalCnt As Long, step As Long
    Dim ipCursor As IFeatureCursor, ipFeature As IFeature
    Dim ipSourceGeom As IGeometry, ipRelOpt  As IRelationalOperator
    Dim ipArea As iArea, ipCenterPt As IPoint
   
    totalCnt = ipFeatureClass.FeatureCount(Nothing)
    Set ipCursor = ipFeatureClass.Update(Nothing, False)
    Set ipFeature = ipCursor.NextFeature
    Do Until ipFeature Is Nothing
        DoEvents
        Application.StatusBar.Message(0) = step & " / " & totalCnt & " calculated..."
        step = step + 1
       
        Set ipSourceGeom = ipFeature.ShapeCopy
        If (ipSourceGeom.GeometryType = esriGeometryPoint) Then
            Set ipCenterPt = ipSourceGeom
        Else
            Set ipArea = ipSourceGeom
            Set ipRelOpt = ipSourceGeom
           
            '폴리곤일 경우 무게중심점(Centroid)이 폴리곤 내부에 포함되지 않을
            '경우가 있으며 이에 대한 처리가 필요합니다. 다음 코드는 폴리곤
            '내부에 포함되지 않을 경우 라벨포인트를 취합니다.
            Set ipCenterPt = ipArea.Centroid
            If (ipRelOpt.Contains(ipCenterPt) = False) Then
                Set ipCenterPt = ipArea.LabelPoint
            End If
        End If
               
        '정보 추출
        Dim sPnu As String, sJibun As String
        Dim dongCode As String, sSan As String, sBunji As String, sHo As String, sJimok As String
       
        sPnu = ipFeature.Value(idxPnu)
        sJibun = ipFeature.Value(idxJibun)
               
        dongCode = Left(sPnu, 10)
        sSan = Mid(sPnu, 11, 1)
        sBunji = Mid(sPnu, 12, 4)
        sHo = Right(sPnu, 4)
       
        sJimok = Right(sJibun, 1)
       
        '만약 번지 및 호의 값을 0034 --> 34로 변경하고 싶을 경우
        sBunji = CStr(CLng(sBunji))
        sHo = CStr(CLng(sHo))
       
        '저장
        ipFeature.Value(ipFeatureClass.FindField("DONG_CODE")) = dongCode
        ipFeature.Value(ipFeatureClass.FindField("SAN")) = sSan
        ipFeature.Value(ipFeatureClass.FindField("BONBUN")) = sBunji
        ipFeature.Value(ipFeatureClass.FindField("BUBUN")) = sHo
        ipFeature.Value(ipFeatureClass.FindField("JIMOK")) = sJimok
       
        ipFeature.Value(ipFeatureClass.FindField("CX")) = ipCenterPt.X
        ipFeature.Value(ipFeatureClass.FindField("CY")) = ipCenterPt.Y
       
        ipCursor.UpdateFeature ipFeature
        Set ipFeature = ipCursor.NextFeature
    Loop
   
    MsgBox "계산을 완료하였습니다 !"
End Sub
[/code]

▣ IMap으로부터 FeatureLayer를 얻는 함수

펼쳐두기..

[code vb]
'+++ Get FeatureLayer
Private Function GetFeatureLayer(ipMap As IMap, layerName As String) As IFeatureLayer
    Dim ipEnumLayer As IEnumLayer
    Dim ipLayer As ILayer
    Dim pUid As New UID
    On Error GoTo ErrHand
   
    If ipMap.LayerCount = 0 Then Exit Function
   
    '{E156D7E5-22AF-11D3-9F99-00C04F6BC78E} IGeoFeatureLayer
    pUid = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
    Set ipEnumLayer = ipMap.Layers(pUid, True)
   
    ipEnumLayer.Reset
    Set ipLayer = ipEnumLayer.Next
    Do Until ipLayer Is Nothing
        If ipLayer.Valid Then
            If UCase(ipLayer.Name) = UCase(layerName) Then
                Set GetFeatureLayer = ipLayer
                Exit Function
            End If
        End If
        Set ipLayer = ipEnumLayer.Next
    Loop
   
    Set GetFeatureLayer = Nothing
    Exit Function
ErrHand:
    Set GetFeatureLayer = Nothing
End Function
[/code]

▣  Table(FeatureClass)에 필드를 추가하는 함수

펼쳐두기..

[code vb]
'+++ Add Field
Private Function AddField(ipTable As ITable, fieldName As String, fieldType As esriFieldType, _
    Optional fieldLength As Long, Optional fieldAlias As String) As Boolean
   
    On Error GoTo ErrHand
   
    If Len(Trim(fieldName)) = 0 Then Exit Function
   
    Dim lPrecision As Long, lScale As Long
   
    Select Case fieldType
        Case esriFieldTypeString
            If IsMissing(fieldLength) Then fieldLength = 50
        Case esriFieldTypeSmallInteger
            If IsMissing(fieldLength) Then fieldLength = 4
            lPrecision = 4
        Case esriFieldTypeInteger
            If IsMissing(fieldLength) Then fieldLength = 9
            lPrecision = 9
        Case esriFieldTypeSingle
            If IsMissing(fieldLength) Then fieldLength = 19
            lPrecision = 19
            lScale = 8
        Case esriFieldTypeDouble
            If IsMissing(fieldLength) Then fieldLength = 38
            lPrecision = 38
            lScale = 8
        Case esriFieldTypeDate
            If IsMissing(fieldLength) Then fieldLength = 8
    End Select
   
    Dim ipField As IField
    Dim ipFieldEdit As IFieldEdit
   
    '필드가 없으면 추가
    If ipTable.FindField(fieldName) = -1 Then 
        Set ipField = New Field
        Set ipFieldEdit = ipField
       
        With ipFieldEdit
            .Editable = True
            .IsNullable = True
            .Name = fieldName
            .Type = fieldType
            .Length = fieldLength
            If Not IsMissing(lPrecision) Then .precision = lPrecision
            If Not IsMissing(lScale) Then .Scale = lScale
            If Len(Trim(fieldAlias)) > 0 Then .AliasName = fieldAlias
            .IsNullable = True
        End With
       
        ipTable.AddField ipField
        AddField = True
    Else
        Set ipField = ipTable.Fields.Field(ipTable.FindField(fieldName))
        If ipField.Editable Then
            AddField = True
        End If
    End If
   
    Exit Function
ErrHand:
    MsgBox "필드 추가 오류 : " & vbCrLf & Err.Description
    AddField = False
End Function
[/code]

▣ 전체 소스코드

ParcelAttributeSplitter.bas

▣ 계산결과 예시