Extract Values of a Raster Layer to a Point Shapefile

Created:5/14/2001
Description:

This sample returns values of raster at given points defined by a point feature class and add those values to the feature class with the specified field name: sFieldName. The field added to the feature class will have different type depending on the input raster.

How to use:
  1. Call this procedure from VB or VBA.
Sub ExtractValueTOPointFeatureClass(pInRaster As IRaster, pInFeatureClass As IFeatureClass, sFieldName As String)
     ' pInRaster: input raster
    ' pInFeatureClass: input point feature class
    ' sFieldName: name of the field that stores the values
    
     On Error GoTo ERH

     ' Define field name
     Dim pFld As IFieldEdit
    Set pFld = New Field
    pFld.Name = sFieldName
    
     ' Define field type
     Dim pProp As IRasterProps
    Set pProp = pInRaster
    If pProp.PixelType = PT_CHAR Or pProp.PixelType = PT_UCHAR Then
        pFld.Type = esriFieldTypeString
        pFld.Length = 20
        pFld.Required = 0
    ElseIf pProp.PixelType = PT_FLOAT Or pProp.PixelType = PT_DOUBLE Or pProp.PixelType Then
        pFld.Type = esriFieldTypeDouble
        pFld.Length = 24
        pFld.Required = 8
    Else  ' for integer case 
        pFld.Type = esriFieldTypeInteger
        pFld.Length = 24
        pFld.Required = 0
    End If
    
     ' Add field
     pInFeatureClass.AddField pFld

     ' Get field index
     Dim FieldIndex As Integer
    FieldIndex = pInFeatureClass.FindField(sFieldName)
    If FieldIndex < 0 Then Exit Sub

     ' Create a raster layer and QI for IIdentify interface
     Dim pRLayer As IRasterLayer
    Set pRLayer = New RasterLayer
    pRLayer.CreateFromRaster pInRaster
    Dim pIdentify As IIdentify
    Set pIdentify = pRLayer
    
    Dim pIDArray As IArray
    Dim pRIDObj As IRasterIdentifyObj
    Dim I As Long
    Dim pPoint As IPoint
    Dim pFeature As IFeature
    Dim pNewPoint As IPoint
    Set pNewPoint = New Point    

     'Loop through each point in the feature class and obtain value of the
    'raster on that point
     Dim NumOfRow As Integer
    NumOfRow = pInFeatureClass.FeatureCount(Nothing)
    For I = 0 To NumOfRow - 1
         'Get point
         Set pFeature = pInFeatureClass.GetFeature(I)
        Set pPoint = pFeature.Shape
        pNewPoint.X = pPoint.X
        pNewPoint.Y = pPoint.Y
         'Get RasterIdentifyObject on that point
         Set pIDArray = pIdentify.Identify(pNewPoint)
        If Not pIDArray Is Nothing Then
            Set pRIDObj = pIDArray.Element(0)
             'Get the value of the RasterIdentifyObject and add it to the field
             If pProp.PixelType = PT_CHAR Or pProp.PixelType = PT_UCHAR Then
            pFeature.Value(FieldIndex) = pRIDObj.Name
            ElseIf pProp.PixelType = PT_FLOAT Or pProp.PixelType = PT_DOUBLE Or pProp.PixelType Then
                If pRIDObj.Name < >  "NoData" Then
                pFeature.Value(FieldIndex) = CDbl(pRIDObj.Name)
                End If
            Else     ' for integer case 
                If pRIDObj.Name < > "NoData" Then
                pFeature.Value(FieldIndex) = CLng(pRIDObj.Name)
                End If
            End If
            pFeature.Store
        End If
    Next I
    Exit Sub
ERH:
    MsgBox Err.Description
End Sub