Private Sub UIButtonControl1_Click()
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 pFeatureCursor As IFeatureCursor
Set pFeatureCursor = pFeatureLayer.FeatureClass.Search(Nothing, False)
Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature
Dim pPolygon As IPolygon
Dim pArea As IArea
Dim pFields As IFields
Dim height As Long
Dim elevation As Long
Dim pPoint As IPoint
Dim x As Double
Dim y As Double
Dim pixelvalue As Variant
Dim column As Long
Dim row As Long
While Not pFeature Is Nothing
Set pPolygon = pFeature.ShapeCopy
Set pArea = pPolygon
Set pPoint = pArea.Centroid
Set pFields = pFeature.Fields
x = pPoint.x
y = pPoint.y
height = pFields.FindField("HEIGHT")
elevation = pFields.FindField("ELEVATION")
column = pRaster2.ToPixelColumn(x)
row = pRaster2.ToPixelRow(y)
pixelvalue = pRaster2.GetPixelValue(0, column, row)
If pFeature.Value(elevation) <> -9999 Then
pFeature.Value(height) = Abs(CDbl(pixelvalue) - pFeature.Value(elevation))
Else
pFeature.Value(height) = 0
End If
pFeature.Store
Set pFeature = pFeatureCursor.NextFeature
Wend
MsgBox "转化完成"
End Sub
