Protected Overrides Sub OnClick() Try Dim pMap As IMap = My.ArcMap.Document.FocusMap Dim pFLIndex As IFeatureLayer = pMap.Layer(0) Dim pFLSections As IFeatureLayer = pMap.Layer(1) 'get selected features from Sections Dim pFeatSel As IFeatureSelection = pFLSections Dim pSelFeats As ISelectionSet = pFeatSel.SelectionSet 'MsgBox(pSelFeats.Count) 'Get feature from Index Layer Dim pIndexFeature As IFeature = Nothing Dim pCursor As ICursor = pFLIndex.Search(Nothing, False) pIndexFeature = pCursor.NextRow 'MsgBox(pBufFeature.OID & " " & pIndexFeature.OID) 'Loop through features in Buffered sections and calculate overlap sq ft Dim pCur As IFeatureCursor = Nothing Dim pBufFeature As IFeature = Nothing pSelFeats.Search(Nothing, False, pCur) pBufFeature = pCur.NextFeature Do Until pBufFeature Is Nothing Dim dblOverLap As Double = GetArea(pBufFeature, pIndexFeature) 'Calls function pBufFeature.Value(10) = dblOverLap pBufFeature.Store() pBufFeature = pCur.NextFeature Loop My.ArcMap.Document.ActiveView.Refresh() Catch ex As Exception MsgBox(ex.ToString & vbCr & vbCr & ex.Message) End Try My.ArcMap.Application.CurrentTool = Nothing End Sub Private Function GetArea(ByVal FeatureA As IFeature, ByVal FeatureB As IFeature) As Double Dim SourceArea As IArea Dim TargetArea As IArea Dim TopoOp As ITopologicalOperator6 Dim IntersectArea As IArea SourceArea = FeatureA.ShapeCopy 'FeatureA and FeatureB are the polygons to be checked for overlap TargetArea = FeatureB.ShapeCopy TopoOp = TargetArea IntersectArea = TopoOp.IntersectEx(SourceArea, False, ESRI.ArcGIS.Geometry.esriGeometryDimension.esriGeometry2Dimension) GetArea = IntersectArea.Area '/ SourceArea.Area) * 100 'returns the percentage of first polygon which overlaps second polygon SourceArea = Nothing TargetArea = Nothing TopoOp = Nothing IntersectArea = Nothing End Function
Solved! Go to Solution.
Any reason for using IntesectEx on ITopologicalOperator6 rather than Intersect of ITopologicalOperator?
Another thing, in your search cursor for the layer 2, if you create a spatial filter with intersect relationship with the layer 1 geometry (single polygon), are you getting all the features you expect?
This is getting interesting. Can you please share your data? Not necessary all the features, just some that overlap but not generating area after the call.
Thanks.
Protected Overrides Sub OnClick() Try Dim pMap As IMap = My.ArcMap.Document.FocusMap Dim pFLIndex As IFeatureLayer = pMap.Layer(0) Dim pFLSections As IFeatureLayer = pMap.Layer(1) Dim pFCSections As IFeatureClass = pFLSections.FeatureClass 'Get feature from Index Layer Dim pIndexFeature As IFeature = Nothing Dim pCursor As ICursor = pFLIndex.Search(Nothing, False) pIndexFeature = pCursor.NextRow 'MsgBox(pBufFeature.OID & " " & pIndexFeature.OID) Dim pSpatialFilter As New SpatialFilter pSpatialFilter.Geometry = pIndexFeature.Shape pSpatialFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects Dim pSelSet As ISelectionSet = pFCSections.Select(pSpatialFilter, esriSelectionType.esriSelectionTypeIDSet, esriSelectionOption.esriSelectionOptionNormal, Nothing) MsgBox(pSelSet.Count) 'get selected features from Sections 'Dim pFeatSel As IFeatureSelection = pFLSections 'Dim pSelFeats As ISelectionSet = pFeatSel.SelectionSet 'MsgBox(pSelFeats.Count) 'Loop through features in Buffered sections and calculate overlap sq ft Dim pCur As IFeatureCursor = Nothing Dim pBufFeature As IFeature = Nothing pSelSet.Search(Nothing, False, pCur) pBufFeature = pCur.NextFeature Do Until pBufFeature Is Nothing Dim dblOverLap As Double = GetArea(pBufFeature, pIndexFeature) 'Calls function pBufFeature.Value(10) = dblOverLap pBufFeature.Store() pBufFeature = pCur.NextFeature Loop My.ArcMap.Document.ActiveView.Refresh() Catch ex As Exception MsgBox(ex.ToString & vbCr & vbCr & ex.Message) End Try My.ArcMap.Application.CurrentTool = Nothing End Sub Private Function GetArea(ByVal FeatureA As IFeature, ByVal FeatureB As IFeature) As Double Dim SourceArea As IArea Dim TargetArea As IArea Dim TopoOp As ITopologicalOperator Dim IntersectArea As IArea SourceArea = FeatureA.ShapeCopy 'FeatureA and FeatureB are the polygons to be checked for overlap TargetArea = FeatureB.ShapeCopy TopoOp = TargetArea Dim TopoOp2 As ITopologicalOperator2 = TargetArea TopoOp2.IsKnownSimple_2 = False TopoOp2.Simplify() IntersectArea = TopoOp2.Intersect(SourceArea, ESRI.ArcGIS.Geometry.esriGeometryDimension.esriGeometry2Dimension) GetArea = IntersectArea.Area '/ SourceArea.Area) * 100 'returns the percentage of first polygon which overlaps second polygon 'SourceArea = Nothing 'TargetArea = Nothing 'TopoOp = Nothing 'IntersectArea = Nothing End Function