How to judge a small polygon intersect a big one on another layer ?

Key Words: Polygon, AO, Center Point, Intersect , Attribute Table
 
 Private Sub ReGenerateParentCode(lngSourceLyrIdx As Long, lngTargetLyrIdx As Long, strFldSource As String, strFldTarget As String)
    Dim pItem As ICommandItem
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    'Dim pFLyrFile As IFeatureLayer
    Dim pFeatureLayerSource As IFeatureLayer
    Dim pFeatureLayerTarget As IFeatureLayer
   
    Dim pCenterPoint As IPoint
    'Dim pEnumFeat As IEnumFeature
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeatureClassSource As IFeatureClass
    Dim pFeatureClassTarget As IFeatureClass
   
    Dim pSelectionSet As ISelectionSet
   
    Dim pFeature As IFeature
    Dim pFeature2 As IFeature
    Dim pPolygon As IPolygon
    Dim pFieldsSource As IFields
    Dim pFieldsTarget As IFields
    Dim pArea As IArea
       
    Dim strDPBND_CD As String
    Dim strDPBND_CD_2 As String
   
    Dim pSpatialFilter As ISpatialFilter
    Dim pOverlayFCursor As IFeatureCursor
   
    Set pItem = ThisDocument.CommandBars.Find(Editor_StartEditing)
    pItem.Execute
   
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
   
    Set pFeatureLayerSource = pMap.Layer(lngSourceLyrIdx)
    Set pFeatureLayerTarget = pMap.Layer(lngTargetLyrIdx)
       
    Set pFeatureClassSource = pFeatureLayerSource.FeatureClass
    Set pFeatureClassTarget = pFeatureLayerTarget.FeatureClass
   
    Set pFieldsSource = pFeatureClassSource.Fields
    Set pFieldsTarget = pFeatureClassTarget.Fields
       
    'strShapeFileName = pFeatureLayer.Name
'    Set pFeatureSelection = pFeatureLayerSource 'LCTN_CD
   
'    pFeatureSelection.SelectFeatures Nothing, esriSelectionResultNew, False  ' select all features 247 total
'    Set pSelectionSet = pFeatureSelection.SelectionSet
   
    Set pFeatureCursor = pFeatureLayerSource.Search(Nothing, False)
'    pSelectionSet.Search Nothing, False, pFeatureCursor ' creates the feature cursor
    Set pFeature = pFeatureCursor.NextFeature
   
    While Not pFeature Is Nothing
        If pFeature.Shape.GeometryType = esriGeometryPolygon Then
            Set pPolygon = pFeature.Shape
            Set pArea = pPolygon
            Set pCenterPoint = pArea.Centroid
            '////////////////////////////////////////////////////////////////////////////////////
            'strDPBND_CD = pFieldsSource.Field("DPBND_CD").DefaultValue
            'strDPBND_CD = pFeature.Value(pFeature.Fields.FindField("DPBND_CD"))
           
            Set pSpatialFilter = New SpatialFilter
            With pSpatialFilter
                Set .Geometry = pCenterPoint
                '.GeometryField = pFeature.FeatureType
                .SpatialRel = esriSpatialRelIntersects
            End With
           
            strDPBND_CD_2 = vbNullString
           
            Set pOverlayFCursor = pFeatureClassTarget.Search(pSpatialFilter, False)
           
            If Not pOverlayFCursor Is Nothing Then
               
                Set pFeature2 = pOverlayFCursor.NextFeature
               
                If Not pFeature2 Is Nothing Then
           
                    strDPBND_CD_2 = pFeature2.Value(pFeature2.Fields.FindField(strFldTarget))
                End If
               
            End If
           
            pFeature.Value(pFeature.Fields.FindField(strFldSource)) = strDPBND_CD_2
            pFeature.Store
           
            '////////////////////////////////////////////////////////////////////////////////////
            'Set pPointCollection = pPolygon
            'save
            'Set pFeature.Shape = pPolygon
            'pFeature.Store
            '////////////////////////////////////////////////////////////////////////////////////
            'move to next polygon
            Set pFeature = pFeatureCursor.NextFeature
        End If
    Wend
   
    Set pItem = ThisDocument.CommandBars.Find(Editor_SaveEdits)
    pItem.Execute   'Quit Editing Mode
    Set pItem = ThisDocument.CommandBars.Find(Editor_StopEditing)
    pItem.Execute   'Quit Editing Mode
   
    Set pItem = Nothing
    Set pMxDoc = Nothing
    Set pMap = Nothing
    Set pFeatureLayerSource = Nothing
    Set pFeatureLayerTarget = Nothing
    Set pCenterPoint = Nothing
    Set pFeatureCursor = Nothing
    Set pFeatureClassSource = Nothing
    Set pFeatureClassTarget = Nothing
    Set pSelectionSet = Nothing
    Set pFeature = Nothing
   
End Sub
posted @ 2007-08-07 10:42  RayG  阅读(313)  评论(0编辑  收藏  举报