arcmap VBA 计算房屋高度

Sub 高程()

'假设河流宽为100m

Dim pMxDoc As IMxDocument
Set pMxDoc = Application.Document

Dim pMap As IMap
Set pMap = pMxDoc.FocusMap

Dim pActiveView As IActiveView
Set pActiveView = pMxDoc.FocusMap

Dim pFeatureClassRiver As IFeatureClass
Dim pFLayerRiver As IFeatureLayer

Dim pFeatureClassLand As IFeatureClass
Dim pFLayerLand As IFeatureLayer

Set pFLayerRiver = pMap.Layer(0)
Set pFLayerLand = pMap.Layer(1)

Set pFeatureClassRiver = pFLayerRiver.FeatureClass
Set pFeatureClassLand = pFLayerLand.FeatureClass

Dim pFeatureCursorRiver As IFeatureCursor
Dim pFeatureCursorLand As IFeatureCursor

'Set pFeatureCursorRiver = pFeatureClassRiver.Search(Nothing, True)
Set pFeatureCursorLand = pFeatureClassLand.Search(Nothing, True)

Dim pFeatureRiver As IFeature
Dim pFeatureLand As IFeature

'Set pFeatureRiver = pFeatureCursorRiver.NextFeature
Set pFeatureLand = pFeatureCursorLand.NextFeature

Dim mindis As Double
Dim index As Integer
index = pFeatureLand.Fields.FindField("限高")

Dim pPolygonRiver As IPolygon
Dim pPolygonLand As IPolygon

Dim pProximityOperator As IProximityOperator

 

While Not pFeatureLand Is Nothing
   Set pPolygonLand = pFeatureLand.ShapeCopy
   Set pProximityOperator = pPolygonLand
   Set pFeatureCursorRiver = pFeatureClassRiver.Search(Nothing, True)
   Set pFeatureRiver = pFeatureCursorRiver.NextFeature
   mindis = 9999
  
   While Not pFeatureRiver Is Nothing
     Set pPolygonRiver = pFeatureRiver.ShapeCopy
      If pProximityOperator.ReturnDistance(pPolygonRiver) < mindis Then
      mindis = pProximityOperator.ReturnDistance(pPolygonRiver)
      End If
      Set pFeatureRiver = pFeatureCursorRiver.NextFeature
   Wend
  
    pFeatureLand.Value(index) = (mindis + 100) / 3#  '房屋限高为距离的1/3
    pFeatureLand.Store
    Set pFeatureLand = pFeatureCursorLand.NextFeature
  
Wend

MsgBox "done!"

End Sub