You are here: > ESRI Forums > arcgis desktop discussion forums > Thread Replies

ArcGIS Desktop Discussion Forums

ArcGIS Desktop - ArcObjects Visual Basic for Application (VBA) forum

removing lots of holes (donuts) from polygo...   Kass Kozloski Jul 14, 2004
Re: removing lots of holes (donuts) from po...   Stony Lohr Jul 15, 2004
Re: removing lots of holes (donuts) from po...   Kass Kozloski Jul 15, 2004
removing holes (donuts) from ALL polygons   Tim Lemmens Feb 28, 2005
Re: removing holes (donuts) from ALL polygo...   Mike Fowler Jul 05, 2005
Re: removing holes (donuts) from ALL polygo...   Brian Sterling Oct 05, 2005
Re: removing holes (donuts) from ALL polygo...   Chris Halcomb May 05, 2009
Re: removing lots of holes (donuts) from po...   Brian Sterling Mar 25, 2005
Re: removing lots of holes (donuts) from po...   Paul Huffman Dec 15, 2005
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject removing lots of holes (donuts) from polygons 
Author Kass Kozloski 
Date Jul 14, 2004 
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
 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing lots of holes (donuts) from polygons 
Author Stony Lohr 
Date Jul 15, 2004 
Message Try modifying your code using the stuff below. The first part is a function that should remove all holes from a polygon. The second part is a code snippet that should replace the code between where you start your edit operation and where you stop it.

The hole removal is written for code simplicity, not for performance. 
 
Public Sub RemoveHoles(pPolygon As IPolygon2)
  Dim pRings As IGeometryCollection
  Dim pTopo As ITopologicalOperator2
  Dim pPart As IArea
  Dim bHoles As Boolean
  Set pRings = pPolygon
  Set pTopo = pPolygon
  pTopo.IsKnownSimple = False
  Dim i As Long
  bHoles = True
  Do While bHoles
    ' loop to remove orphaned islands
    bHoles = False
    pPolygon.SimplifyPreserveFromTo
    For i = pRings.GeometryCount - 1 To 0 Step -1
      Set pPart = pRings.Geometry(i)
      If pPart.Area <= 0 Then
        pRings.RemoveGeometries i, 1
        bHoles = True
      End If
    Next i
  Loop
End Sub

''''''''''''''''''''''''''''''''''''''

'start operation

Dim pPolygon as IPolygon2
set pPolygon = pF.ShapeCopy
RemoveHoles pPolygon
set pF.Shape = pPolygon
pF.Store

'stop operation
 
  Stony Lohr 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing lots of holes (donuts) from polygons 
Author Kass Kozloski 
Date Jul 15, 2004 
Message Thanks! A couple minor changes and I had what I was after. 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject removing holes (donuts) from ALL polygons 
Author Tim Lemmens 
Date Feb 28, 2005 
Message Thanks! Both your code helped me quickly creating a script that removes the donuts from all polygons in a feature class (shapefile in my case).

kind regards
tim 
 
Public 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
    
    
    'loop through all features
    Dim pFC As IFeatureClass
    Set pFC = pFlay.FeatureClass
    Dim lngI As Long
    Dim lngTot As Long
    lngTot = pFC.FeatureCount(Nothing)
    Dim pF As IFeature
    Dim pPolygon As IPolygon2
    pEditor.StartOperation
    For lngI = 0 To lngTot - 1
        Set pF = pFC.GetFeature(lngI)
        Set pPolygon = pF.Shape
        Debug.Print "processing record no."; lngI; "/"; lngTot - 1
        RemoveDonutHoles pPolygon
        Set pF.Shape = pPolygon
        pF.Store
    Next lngI
    pEditor.StopOperation "Remove Holes"
    
    'clear selection
    pMxDoc.FocusMap.ClearSelection
    'refresh display
    pActiveView.PartialRefresh esriViewGeography, pLayer, Nothing
    
    Exit Sub
ErrorHandler:
  MsgBox "Error." & vbCr & vbCr & _
         "Error Details : " & Err.Description, vbExclamation + vbOKOnly, "Error"

End Sub

Private Sub RemoveDonutHoles(pPolygon As IPolygon2)
  Dim pRings As IGeometryCollection
  Dim pTopo As ITopologicalOperator2
  Dim pPart As IArea
  Dim bHoles As Boolean
  Set pRings = pPolygon
  Set pTopo = pPolygon
  pTopo.IsKnownSimple = False
  Dim i As Long
  bHoles = True
  Do While bHoles
    ' loop to remove orphaned islands
    bHoles = False
    pPolygon.SimplifyPreserveFromTo
    For i = pRings.GeometryCount - 1 To 0 Step -1
      Set pPart = pRings.Geometry(i)
      If pPart.Area <= 0 Then
        pRings.RemoveGeometries i, 1
        bHoles = True
      End If
    Next i
  Loop
End Sub
 
  Tim Lemmens
http://www.droopi.net 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing holes (donuts) from ALL polygons 
Author Mike Fowler 
Date Jul 05, 2005 
Message Hey Tim,

thanks for the code snippet it worked great on my shapefile!

mofocop 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing holes (donuts) from ALL polygons 
Author Brian Sterling 
Date Oct 05, 2005 
Message Thanks Tim,
Your code to remove donut holes worked to perfection. 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing holes (donuts) from ALL polygons 
Author Chris Halcomb 
Date May 05, 2009 
Message Tim,
Thank you! Your code worked great!

 
  Chris Halcomb
KGIS Landbase Administrator 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing lots of holes (donuts) from polygons 
Author Brian Sterling 
Date Mar 25, 2005 
Message Use these two toolbox tools to create a feature as a single polygon or lake, removing any holes or islands. Then when one uses a macro to find the perimeter, it is of only the length of the outermost polygon or lake.

To fill the holes,
1. Create a polygon shape just around the holes. I used a customize tool called "Create n Add Shapefile.dll". Try to find it on the web. (It's good for this use but I don't think it has the capability to edit in projection coordinates.)
2. Union the two layers with the Union tool. A "unioned" layer is created and placed on the map
and TOC.
3. Then dissolve the unioned layer using the Dissolve tool.
I setup and ran this process intuitively and it's smooth operation was good but I have difficulty running this while keeping the associate data.


Brian Sterling
Cartographer
USDA, APHIS, PPQ, ISPM
Riverdale, MD 20737
Unit 546
 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: removing lots of holes (donuts) from polygons 
Author Paul Huffman 
Date Dec 15, 2005 
Message Why do I keep getting a msgBox Error: Item not found in this collection. when running Tim's VB macro? 
  Paul Huffman
Yakama Indian Nation Fisheries
http://ykfp.org