vba 宗地内的土地利用类型

Sub LU()

Dim app As IApplication
Set app = Application

Dim pMxDocument As IMxDocument
Set pMxDocument = Application.Document

Dim pMap As IMap
Set pMap = pMxDocument.FocusMap

Dim pFeatureLayerZone As IFeatureLayer
Set pFeatureLayerZone = pMap.Layer(0) '第一个图层是zone

Dim pFeatureLayerLU As IFeatureLayer
Set pFeatureLayerLU = pMap.Layer(1) '第二个图层是landuse

Dim pFeatureClassZone As IFeatureClass
Set pFeatureClassZone = pFeatureLayerZone.FeatureClass

Dim pFeatureClassLU As IFeatureClass
Set pFeatureClassLU = pFeatureLayerLU.FeatureClass


Dim pFeatureCursorZone As IFeatureCursor
Set pFeatureCursorZone = pFeatureClassZone.Search(Nothing, False)

Dim pFeatureCursorLU As IFeatureCursor


Dim pFeatureZone As IFeature
Set pFeatureZone = pFeatureCursorZone.NextFeature

Dim pRelZone As IRelationalOperator
Dim zoneIndex As Long
zoneIndex = pFeatureClassZone.Fields.FindField("LU_zj") 'zone添加新的字段为LU_zj,用于记录和它相交的土地类型


Dim pFeatureLU As IFeature



Dim pGeoLU As IGeometry
Dim luIndex As Long
luIndex = pFeatureClassLU.Fields.FindField("实地调查地") '"实地调查地"是被考察的字段
Dim fValues As String




While Not pFeatureZone Is Nothing

   Set pRelZone = pFeatureZone.Shape
   fValues = ""
   

   Set pFeatureCursorLU = pFeatureClassLU.Search(Nothing, False) '重头获取cursor，不然跑空
   Set pFeatureLU = pFeatureCursorLU.NextFeature
   
   
   While Not pFeatureLU Is Nothing
     Set pGeoLU = pFeatureLU.Shape
     
       If pRelZone.Overlaps(pGeoLU) Then '空间关系overlaps，contain等
       
          If InStr(fValues, pFeatureLU.Value(luIndex)) = 0 Then   '删除重复，没找到的才添加
          
             fValues = fValues & pFeatureLU.Value(luIndex) & ","
         
         End If
         
       End If
       
     Set pFeatureLU = pFeatureCursorLU.NextFeature
   Wend
   
   If Len(fValues) > 1 Then
    
       fValues = Left(fValues, Len(fValues) - 1)
    
   End If
   
   pFeatureZone.Value(zoneIndex) = fValues
   pFeatureZone.Store
    

   Set pFeatureZone = pFeatureCursorZone.NextFeature
Wend




End Sub