Geospatial Analysis and Resource Center

Option Explicit
Private m_ipMap As IMap

Public Sub CalculateRasterValue()
    Dim ipDoc As IMxDocument
    Set ipDoc = ThisDocument
    Set m_ipMap = ipDoc.FocusMap

    Dim ipFeatureLayer As IFeatureLayer, ipFeatureClass As IFeatureClass
    Dim fieldName As String, idxField As Long, ipField As IField
    Dim ipRasterLayer As IRasterLayer
    
    Set ipFeatureLayer = GetFeatureLayer(m_ipMap, "POINT")
    Set ipRasterLayer = GetRasterLayer(m_ipMap, "DEM")
    
    If (ipFeatureLayer Is Nothing Or ipRasterLayer Is Nothing) Then
        MsgBox "포인트 또는 래스터 레이어가 없습니다. 확인 바랍니다."
        Exit Sub
    End If
    
    Set ipFeatureClass = ipFeatureLayer.FeatureClass
            
    '1. 필드가 없으면 Double 필드를 추가함
    fieldName = "GRID_VALUE"
    AddField ipFeatureClass, fieldName, esriFieldTypeDouble
    
    idxField = ipFeatureClass.FindField(fieldName)
    Set ipField = ipFeatureClass.Fields.Field(idxField)
    
    '2. prepare identify
    Dim ipIdentify As IIdentify, ipRasterIDObj As IRasterIdentifyObj
    Dim ipArray As IArray, rasterValue As Variant
    
    Set ipIdentify = ipRasterLayer
    
    '3. 계산
    Dim totalCnt As Long, step As Long
    Dim ipQf As IQueryFilter, ipCursor As IFeatureCursor
    Dim ipFeature As IFeature, ipCurPoint As IPoint
        
    totalCnt = ipFeatureClass.FeatureCount(Nothing)
    
    Set ipQf = New QueryFilter
    ipQf.SubFields = ipFeatureClass.ShapeFieldName & ", " & fieldName
    
    Set ipCursor = ipFeatureClass.Update(ipQf, False)
    Set ipFeature = ipCursor.NextFeature
    Do Until ipFeature Is Nothing
        DoEvents
        Application.StatusBar.Message(0) = step & " / " & totalCnt & " calculated..."
        step = step + 1
        
        rasterValue = 0#
        Set ipCurPoint = ipFeature.ShapeCopy
        
        '래스터 레이어의 값 가져오기
        Set ipArray = ipIdentify.Identify(ipCurPoint)
        If (Not ipArray Is Nothing) Then
            If (ipArray.Count > 0) Then
                Set ipRasterIDObj = ipArray.Element(0)
                If (IsNumeric(ipRasterIDObj.Name)) Then
                    rasterValue = ipRasterIDObj.Name
                End If
            End If
        End If
        
        '필드 유형에 맞게 값 확인
        Select Case ipField.Type
            Case esriFieldTypeSmallInteger
                rasterValue = CInt(rasterValue)
            Case esriFieldTypeInteger
                rasterValue = CLng(rasterValue)
            Case esriFieldTypeDouble
                rasterValue = CDbl(rasterValue)
            Case esriFieldTypeString
                rasterValue = CStr(rasterValue)
        End Select
        
        '저장
        ipFeature.Value(idxField) = rasterValue
        ipCursor.UpdateFeature ipFeature
        
        Set ipFeature = ipCursor.NextFeature
    Loop
    
    MsgBox "계산을 완료하였습니다 !"
End Sub