Scripting_SmoothPolygonProcess

ET GeoWizards Scripting

Smooth Polygons - How to do it?

Since the release of EditTools for ArcView 3.x, and even more often after the release of ET GeoWizards this is one of the most frequently asked questions. In general this should not be a procedure much more difficult than smoothing a polyline, but there are several considerations that need to be taken into account. Read the ET GeoWizards Frequently Asked Questions for an explanation.

So if we want to smooth polygons and preserve the topological relationships between them we need a several step procedure:

Step1: Convert your polygons to polylines
Step2: Clean the resulting polyline layer
Step3: Smooth the polylines
Step4: Build a new polygon feature class from the smoothed polylines

This is achievable with the functions available in ET GeoWizards 8.7, but each of the steps needs to be performed via the interface.

The main purpose of this topic is to show how the Scripting introduced in ET GeoWizards 9.0 can help you to perform complex geoprocessing with just few lines of code.

How to smooth polygons and keep the polygon dataset topologically correct?

The four step procedure above is a bit generalized. We need at least two more steps if you want to preserve the polygon attributes. The scheme below gives a graphic description of the entire process

The process above might look a bit complex, but can be achieved using ET GeoWizards Scripting with just few lines of code (Have in mind that to achieve this with the standard ArcObjects you'll need thousands lines of code)

A. Basic code - If we remove the comments it is about 20 lines of code. If we take out the declarations and the basic stuff, the entire procedure is accomplished in 8 lines of code!

Sub SmoothPolygons1()
'Some declarations needed
Dim pMxDoc As IMxDocument 'Current document
Dim pMap As IMap ' The map
Dim ET As New ETGW_Core ' ET GeoWizards library
Dim pFeatureLayer As IFeatureLayer 'A feature layer
Dim pInFeatureClass As IFeatureClass ' The input feature class
Dim pOutFeatureClass As IFeatureClass ' The resulting feature class
Dim pLabelFeatureClass As IFeatureClass ' A feature class that we going to use to transfer the attributes
' Now set some of the variables
Set pMxDoc = ThisDocument 'Get the document
Set pMap = pMxDoc.FocusMap ' Get the Map
' Here we are going to use the currently selected layer in the TOC to
Set pFeatureLayer = pMxDoc.SelectedLayer ' Get the polygon layer to be smoothed
Set pInFeatureClass = pFeatureLayer.FeatureClass 'Get the feature class of the input layer
'Here the actual process begins
'1. Get the label points of the original polygons
Set pLabelFeatureClass = ET.PolygonToPoint(pInFeatureClass, "c:\00\labels.shp", "Label", False)
'2. Convert the polygons to polylines
Set pOutFeatureClass = ET.PolygonToPolyline(pInFeatureClass, "c:\00\polylines.shp")
'3. Clean the polylines ( the duplicate lines on the common boundary need to be removed)
Set pOutFeatureClass = ET.CleanPolyline(pOutFeatureClass, "c:\00\polylines_clean.shp", 0.0001)
'4. An optional step that might be needed if we want better approximation of the original polygons
Set pOutFeatureClass = ET.DensifyPolylines(pOutFeatureClass, "c:\00\polylines_densified.shp", 0.02, 0.02)
'5. This is the actual smoothing
Set pOutFeatureClass = ET.SmoothPolylines(pOutFeatureClass, "c:\00\polylines_smooth.shp", "bSpline", 5, 3)
'6. Another optional step - getting rid of the excess vertices
Set pOutFeatureClass = ET.GeneralizePolylines(pOutFeatureClass, "c:\00\polylines_generalized.shp", 0.0002)
'7. Now we can rebuild the polygons using the smoothed polylines
Set pOutFeatureClass = ET.BuildPolygons(pOutFeatureClass, "c:\00\polygons.shp", False, 0.0001)
'8. Use the Spatial Join to get the attributes back to the smoothed polygons
Set pOutFeatureClass = ET.Spatial_Join(pOutFeatureClass, pLabelFeatureClass, _
"c:\00\polygons_final.shp", "Nearest", True, 0)
'The rest is standard
Set pFeatureLayer = New FeatureLayer 'create a new feature layer
Set pFeatureLayer.FeatureClass = pOutFeatureClass 'set the feature class to the layer
pFeatureLayer.Name = pOutFeatureClass.AliasName ' set the name of the layer
pMap.AddLayer pFeatureLayer ' add the layer to the map
End Sub

B. Some error checking, resources and file cleaning is always a good practice. The code becomes a bit longer, but is more manageable

Sub SmoothPolygons2()
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim ET As New ETGW_Core
    Dim pFeatureLayer As IFeatureLayer
    Dim pInFeatureClass As IFeatureClass
    Dim pOutFeatureClass As IFeatureClass
    Dim pLabelFeatureClass As IFeatureClass
    Dim bDone As Boolean
    On Error GoTo EH
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    Set pFeatureLayer = pMxDoc.SelectedLayer
    'Check if the user has selected a layer in the TOC
    If pFeatureLayer Is Nothing Then
        MsgBox "No selected layer"
        Exit Sub
    End If
    Set pInFeatureClass = pFeatureLayer.FeatureClass

    Set pLabelFeatureClass = ET.PolygonToPoint(pInFeatureClass, "c:\00\labels.shp", "Label", False)
    'Check if the process completed successfully. This step is repeated for every sub process below
    If pLabelFeatureClass Is Nothing Then
        MsgBox "Error in step 0"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.PolygonToPolyline(pInFeatureClass, "c:\00\polylines.shp")
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 1"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.CleanPolyline(pOutFeatureClass, "c:\00\polylines_clean.shp", 0.0001)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 2"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.DensifyPolylines(pOutFeatureClass, "c:\00\polylines_densified.shp", 0.02, 0.02)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 3"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.SmoothPolylines(pOutFeatureClass, "c:\00\polylines_smooth.shp", "bSpline",   5, 3)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 4"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.GeneralizePolylines(pOutFeatureClass, "c:\00\polylines_generalized.shp", 0.0002)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 5"
        Exit Sub
    End If

    Set pOutFeatureClass = ET.BuildPolygons(pOutFeatureClass, "c:\00\polygons.shp", False, 0.0001)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 6"
        Exit Sub
    End If
    Set pOutFeatureClass = ET.Spatial_Join(pOutFeatureClass, pLabelFeatureClass, _
"c:\00\polygons_final.shp", "Nearest", True, 0)
    If pOutFeatureClass Is Nothing Then
        MsgBox "Error in step 7"
        Exit Sub
    End If
    'Delete the unneeded intermediate feature classes
    bDone = ET.Deletefeature class("c:\00\labels.shp")
    bDone = ET.Deletefeature class("c:\00\polylines.shp")
    bDone = ET.Deletefeature class("c:\00\polylines_clean.shp")
    bDone = ET.Deletefeature class("c:\00\polylines_densified.shp")
    bDone = ET.Deletefeature class("c:\00\polylines_smooth.shp")
    bDone = ET.Deletefeature class("c:\00\polylines_generalized.shp")
    bDone = ET.Deletefeature class("c:\00\polygons.shp")

    Set pFeatureLayer = New FeatureLayer
    Set pFeatureLayer.FeatureClass = pOutFeatureClass
    pFeatureLayer.Name = pOutFeatureClass.AliasName
    pMap.AddLayer pFeatureLayer
   'Release the object variables
    Set pMxDoc = Nothing
    Set pMap = Nothing
    Set pFeatureLayer = Nothing
    Set pInFeatureClass = Nothing
    Set pOutFeatureClass = Nothing
    Set pLabelFeatureClass = Nothing
    Exit Sub
EH:
    MsgBox Err.Description
End Sub

Copy friendly version of the script above