| Message |
Hi. I'm new to this stuff, just so you know. I have several polygons that have thousands of little holes in them (or donuts if you prefer). I want to fill in these holes that are smaller then a certain size. My code is below (the size part isn't thier yet, just trying to delete the holes). Basically, I have got the array of the Interior Rings, but I don't know how to delete these rings (i'm sure its easy). The SetEmpty command doesn't do anything. Or, not what I think its suppose to. Am I missing a something? |
| |
Sub RemoveHoles()
On Error GoTo ErrorHandler
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
'if not in Data View, abort
If TypeOf pMxDoc.ActiveView Is IPageLayout Then
MsgBox "Must be in Data View."
Exit Sub
End If
'if not editing, abort
Dim pID As New UID
pID = "esriCore.Editor"
Dim pEditor As IEditor
Set pEditor = Application.FindExtensionByCLSID(pID)
If pEditor.EditState = esriStateNotEditing Then
MsgBox "Not in Edit Mode."
Exit Sub
End If
' Get the ActiveView for the map
Dim pActiveView As IActiveView
Set pActiveView = pMxDoc.FocusMap
' Refresh the selections
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
' get the active layer
Dim pLayer As ILayer
Set pLayer = pMxDoc.SelectedLayer
If pMxDoc.SelectedItem Is Nothing Then
MsgBox "Select one polygon layer first."
Exit Sub
ElseIf Not TypeOf pMxDoc.SelectedItem Is IFeatureLayer Then
MsgBox "Select only one polygon layer first."
Exit Sub
End If
Dim pFlay As IFeatureLayer
Set pFlay = pMxDoc.SelectedItem
'make sure it's a polygon type
If pFlay.FeatureClass.ShapeType <> esriGeometryPolygon Then
MsgBox "Select one POLYGON layer first."
Exit Sub
End If
'layer must be editable
Dim pEditLayers As IEditLayers
Set pEditLayers = pEditor
If Not pEditLayers.IsEditable(pFlay) Then
MsgBox "Selected layer is not editable. Please select correct layer in TOC."
Exit Sub
End If
'count the number of selected shapes
Dim pFeatSel As IFeatureSelection
Set pFeatSel = pFlay 'QI
Dim pSelSet As ISelectionSet
Set pSelSet = pFeatSel.SelectionSet
If pSelSet.Count <> 1 Then
MsgBox "Select only one polygon."
Exit Sub
End If
'get the selected shape
Dim pFcurs As IFeatureCursor
pSelSet.Search Nothing, False, pFcurs
Dim pF As IFeature
Set pF = pFcurs.NextFeature
Dim lOID As Long
lOID = pF.OID
pEditor.StartOperation
Dim pPolygon As IPolygon2
Set pPolygon = pF.Shape
Dim extRingCount As Long
Dim intRingCount As Long
Dim numReturned As Long
Dim doMoreExist As Boolean
'intRingCount = pPolygon.InteriorRingCount
'extRingCount = pPolygon.ExteriorRingCount
Dim pExtRing() As IRing
Dim pIntRings() As IRing
'Redimension the array of rings based on the number of exterior rings in the polygon
ReDim pExtRing(pPolygon.ExteriorRingCount - 1)
pPolygon.QueryExteriorRingsEx pPolygon.ExteriorRingCount, pExtRing(0)
ReDim pIntRings(pPolygon.InteriorRingCount(pExtRing(0)) - 1)
pPolygon.QueryInteriorRingsEx pExtRing(0), pPolygon.InteriorRingCount(pExtRing(0)), pIntRings(0)
' Dim pPointColl As IPointCollection
Dim i As Integer
i = 0
Do While i < pPolygon.InteriorRingCount(pExtRing(0))
pIntRings(i).SetEmpty
' Set pPointColl = pIntRings(i)
' pPointColl.RemovePoints 0, pPointColl.PointCount - 1
i = i + 1
Loop
pEditor.StopOperation "Remove Holes"
'clear selection
pMxDoc.FocusMap.ClearSelection
'select just the new feature
pMxDoc.FocusMap.SelectFeature pLayer, pF
'refresh display
pActiveView.PartialRefresh esriViewGeography, pLayer, Nothing
Exit Sub
ErrorHandler:
MsgBox "Error." & vbCr & vbCr & _
"Error Details : " & Err.Description, vbExclamation + vbOKOnly, "Error"
End Sub |