arcmap vba 根据DEM高程值生成Shp高程字段

Dim app As IApplication
Set app = Application

Dim pMxDocument As IMxDocument
Set pMxDocument = Application.Document

Dim pMap As IMap
Set pMap = pMxDocument.FocusMap

Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pMap.Layer(0)

Dim pRasterLayer As IRasterLayer
Set pRasterLayer = pMap.Layer(1)

Dim pRaster2 As IRaster2
Set pRaster2 = pRasterLayer.Raster

Dim pRasterPros As IRasterProps
Set pRasterPros = pRaster2

Dim pFC As IFeatureClass
Set pFC = pFeatureLayer.FeatureClass

Dim pFeatureBuffer As IFeatureBuffer
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pPoint As IPoint
Dim pt As IPoint
Dim q As Long

Dim index As Long
index = pFC.Fields.FindField("height")

Dim i As Long
Dim j As Long
Dim row As Long
Dim column As Long

row = pRasterPros.Height
column = pRasterPros.Width

For i = 0 To row - 1
For j = 0 To column - 1

    Set pPoint = New Point
    pPoint.X = pRaster2.ToMapX(j)
    pPoint.Y = pRaster2.ToMapY(i)
   
Set pFeatureBuffer = pFC.CreateFeatureBuffer
Set pFeatureCursor = pFC.Insert(True)
Set pFeature = pFeatureBuffer

Set pFeature.Shape = pPoint
pFeature.Value(index) = pRaster2.GetPixelValue(0, j, i)

q = pFeatureCursor.InsertFeature(pFeatureBuffer)

Next j
Next i

pFeatureCursor.Flush

MsgBox "Done!"