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