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