Sub 高程处理()
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 pTinLayer As ITinLayer
Set pTinLayer = pMap.Layer(1)
Dim pFuncSurf As IFunctionalSurface
Set pFuncSurf = pTinLayer.Dataset
Dim pFeatureCursor As IFeatureCursor
Set pFeatureCursor = pFeatureLayer.FeatureClass.Update(Nothing, False) ‘用于修改的cursor
Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature
Dim pPoint As IPoint
Dim x As Double
Dim y As Double
Dim z As Double
Dim index As Integer
Dim pFields As IFields
While Not pFeature Is Nothing
Set pPoint = pFeature.ShapeCopy
x = pPoint.x
y = pPoint.y
z = pFuncSurf.z(x, y)
Set pFields = pFeature.Fields
index = pFields.FindField("Elevation")
pFeature.Value(index) = z
pFeatureCursor.UpdateFeature pFeature ‘用于修改的cursor，效率提高不少
Set pFeature = pFeatureCursor.NextFeature
Wend
MsgBox "转化完成"
End Sub