Friend Sub EliminateSlivers(ByVal m_app As ESRI.ArcGIS.Framework.IApplication, ByVal pFLayer As ESRI.ArcGIS.Carto.IFeatureLayer, ByVal MMU As Double, ByVal EliminateType As String) Dim IsEditing As Boolean = True Dim pDataset As ESRI.ArcGIS.Geodatabase.IDataset Dim pEditor As ESRI.ArcGIS.Editor.IEditor Dim pEditLayers As ESRI.ArcGIS.Editor.IEditLayers Dim pFCursor As ESRI.ArcGIS.Geodatabase.IFeatureCursor Dim pFeature As ESRI.ArcGIS.Geodatabase.IFeature Dim pArea As ESRI.ArcGIS.Geometry.IArea Dim pAdjFeature As ESRI.ArcGIS.Geodatabase.IFeature Dim pTopoOp As ESRI.ArcGIS.Geometry.ITopologicalOperator Try pDataset = pFLayer pEditor = m_app.FindExtensionByName("ESRI Object Editor") If pEditor.EditState <> ESRI.ArcGIS.Editor.esriEditState.esriStateEditing Then IsEditing = False pEditor.StartEditing(pDataset.Workspace) End If pEditLayers = pEditor pEditLayers.SetCurrentLayer(pFLayer, 0) pEditor.StartOperation() pFCursor = pFLayer.FeatureClass.Search(Nothing, False) pFeature = pFCursor.NextFeature Do Until pFeature Is Nothing pArea = pFeature.Shape If pArea.Area < MMU Then If EliminateType = "Border" Then pAdjFeature = GetLongestBorderAdjacent(pFeature) Else pAdjFeature = GetLargestAdjacent(pFeature) End If If pAdjFeature IsNot Nothing Then pTopoOp = pAdjFeature.ShapeCopy pAdjFeature.Shape = pTopoOp.Union(pFeature.ShapeCopy) pAdjFeature.Store() pFeature.Delete() End If End If pFeature = pFCursor.NextFeature Loop pEditor.StopOperation("Merge") If Not IsEditing Then pEditor.StopEditing(True) End If Catch ex As Exception ExceptionMessage(ex, "Eliminate Slivers") Finally Release(pFCursor) End Try End Sub Private Function GetArea(ByVal pArea As ESRI.ArcGIS.Geometry.IArea) As Double GetArea = pArea.Area End Function Public Function GetBorderLen(ByVal pPoly1 As ESRI.ArcGIS.Geometry.IPolygon, ByVal pPoly2 As ESRI.ArcGIS.Geometry.IPolygon) As Double Dim pTopoOp As ESRI.ArcGIS.Geometry.ITopologicalOperator = pPoly1 Dim pGeo As ESRI.ArcGIS.Geometry.IGeometry = pTopoOp.Intersect(pPoly2, ESRI.ArcGIS.Geometry.esriGeometryDimension.esriGeometry1Dimension) If Not pGeo.IsEmpty Then Dim pPoly3 As ESRI.ArcGIS.Geometry.IPolyline = pGeo Return pPoly3.Length Else Return 0.0 End If End Function Friend Function GetLargestAdjacent(ByVal pFeat As ESRI.ArcGIS.Geodatabase.IFeature) As ESRI.ArcGIS.Geodatabase.IFeature Dim pSF As ESRI.ArcGIS.Geodatabase.ISpatialFilter = New ESRI.ArcGIS.Geodatabase.SpatialFilter Dim pFC As ESRI.ArcGIS.Geodatabase.IFeatureClass Dim pFCur As ESRI.ArcGIS.Geodatabase.IFeatureCursor Dim pFeat2 As ESRI.ArcGIS.Geodatabase.IFeature Dim pLargestFeat As ESRI.ArcGIS.Geodatabase.IFeature Dim dMaxArea As Double Try pSF.Geometry = pFeat.Shape pSF.SpatialRel = ESRI.ArcGIS.Geodatabase.esriSpatialRelEnum.esriSpatialRelIntersects pFC = pFeat.Class pFCur = pFC.Search(pSF, False) pFeat2 = pFCur.NextFeature Do Until pFeat2 Is Nothing If pLargestFeat Is Nothing Then pLargestFeat = pFeat2 dMaxArea = GetArea(pFeat2.Shape) Else If GetArea(pFeat2.Shape) > dMaxArea Then pLargestFeat = pFeat2 dMaxArea = GetArea(pFeat2.Shape) End If End If pFeat2 = pFCur.NextFeature Loop Return pLargestFeat Catch ex As Exception ExceptionMessage(ex, "Get Largest Feature") Return Nothing End Try End Function Public Function GetLongestBorderAdjacent(ByVal pFeat As ESRI.ArcGIS.Geodatabase.IFeature) As ESRI.ArcGIS.Geodatabase.IFeature Dim pSF As ESRI.ArcGIS.Geodatabase.ISpatialFilter = New ESRI.ArcGIS.Geodatabase.SpatialFilter Dim pFC As ESRI.ArcGIS.Geodatabase.IFeatureClass Dim pFCur As ESRI.ArcGIS.Geodatabase.IFeatureCursor Dim pFeat2 As ESRI.ArcGIS.Geodatabase.IFeature Dim pLongestBorderFeat As ESRI.ArcGIS.Geodatabase.IFeature Dim dMaxLen As Double Try pSF.Geometry = pFeat.Shape pSF.SpatialRel = ESRI.ArcGIS.Geodatabase.esriSpatialRelEnum.esriSpatialRelIntersects pFC = pFeat.Class pFCur = pFC.Search(pSF, False) pFeat2 = pFCur.NextFeature Do Until pFeat2 Is Nothing If pFeat2.OID <> pFeat.OID Then If pLongestBorderFeat Is Nothing Then pLongestBorderFeat = pFeat2 dMaxLen = GetBorderLen(pFeat.Shape, pFeat2.Shape) Else If GetBorderLen(pFeat.Shape, pFeat2.Shape) > dMaxLen Then pLongestBorderFeat = pFeat2 dMaxLen = GetBorderLen(pFeat.Shape, pFeat2.Shape) End If End If End If pFeat2 = pFCur.NextFeature Loop Return pLongestBorderFeat Catch ex As Exception ExceptionMessage(ex, "Get Longest Feature") Return Nothing Finally Release(pFCur) End Try End Function
Signed in members can post, follow updates, and more. New here? Register a free account.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.