Convert closed Polylines to a Polygon FeatureClass

Created:1/8/2001
Description:

The code below takes the closed Polylines from an existing FeatureClass, and creates a new FeatureClass of Polygons from them. The FeatureClass must be in a GeoDatabase FeatureDataset - the new FeatureClass is created in this FeatureDataset.

How to use:
  1. Open ArcMap, open the VBA editor and paste the code below into the code window.
  2. Add a FeatureDataset containing a Polyline FeatureClass. Some of the Polyline features should form closed loops.
  3. Run the ClosedLinesNewFC macro.
Public Sub ClosedLinesNewFC()
  '
  ' Get the current map.
  '
  Dim pMxDoc As IMxDocument, pMap As IMap
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  '
  ' Here, we select the top layer in the Map to work with.
  '
  Dim pFeatureLyr As IFeatureLayer, pFeatureClass As IFeatureClass
  If TypeOf pMap.Layer(0) Is IFeatureLayer Then
    Set pFeatureLyr = pMap.Layer(0)
    Set pFeatureClass = pFeatureLyr.FeatureClass
    '
    ' Check the layer belongs to a (Local or Remote) GeoDatabase FeatureDataset - we will 
    ' add the new FeatureClass of Polygons to this same FeatureDataset.
    '
    If Not pFeatureClass.FeatureDataset Is Nothing Then
      Dim pFeatureDataset As IFeatureDataset
      Set pFeatureDataset = pFeatureClass.FeatureDataset
      If Not pFeatureDataset.Workspace.Type = esriFileSystemWorkspace Then
		    '
        ' Check we have some closed lines before going ahead and creating a FeatureClass.
        '
        If fnHasClosedLines(pFeatureClass) Then
          '
          ' If we have found some closed lines, then create a FeatureClass. The first step
          ' is to establish a fields collection, by copying the existing Fields collection,
          ' and altering the GeometryDef to contain Polygons instead of Polylines.
          '
          Dim pNewFields As IFields
          Set pNewFields = fnMakePolygonFields(pFeatureClass.Fields, pFeatureClass.ShapeFieldName)
          If pNewFields Is Nothing Then Exit Sub
          If Not pNewFields.FieldCount = pFeatureClass.Fields.FieldCount Then Exit Sub
          '
          ' Create the new FeatureClass in the FeatureDataset, using the cloned and edited
          ' Fields collection, and the name NewPolygons.
          '
          Dim pNewFeatureClass As IFeatureClass
          Set pNewFeatureClass = pFeatureDataset.CreateFeatureClass("NewPolygons", pNewFields, Nothing, Nothing, esriFTSimple, pFeatureClass.ShapeFieldName, "")
          '
          ' Start editing the FeatureClass we have created.
          '
          Dim pNewDataset As IDataset, pNewWorkspaceEdit As IWorkspaceEdit
          Set pNewDataset = pNewFeatureClass
          Set pNewWorkspaceEdit = pNewDataset.Workspace
          pNewWorkspaceEdit.StartEditing False
          pNewWorkspaceEdit.StartEditOperation
          '
          ' Now we create a FeatureCursor from all of the features in the original feature
          ' class. We use this cursor to iterate the features to find closed Polylines.
          '
          Dim pFeatureCursor As IFeatureCursor, pFeature As IFeature
          Set pFeatureCursor = pFeatureClass.Search(Nothing, False)
          Set pFeature = pFeatureCursor.NextFeature
        
          Dim pCurve As ICurve
          Do While Not pFeature Is Nothing
          
            Set pCurve = pFeature.Shape
            If fnCurveClosed(pCurve) Then
              '
              ' Add the closed line to the new FeatureClass as a Polygon, copying the attributes.
              '
              Dim pPolygon As IPolygon
              Set pPolygon = fnPolylineToPolygon(pCurve)
              Dim pNewFeature As IFeature
              Set pNewFeature = pNewFeatureClass.CreateFeature
              '
              ' Iterate all the Fields to copy the attribute values.
              '
              Dim i As Integer
              For i = 0 To pNewFields.FieldCount - 1
                If (Not pNewFields.Field(i).Type = esriFieldTypeGeometry) And (Not pNewFields.Field(i).Type = esriFieldTypeOID) Then
                  If pNewFields.Field(i).Editable Then
                    pNewFeature.Value(i) = pFeature.Value(i)
                  End If
                End If
              Next i
              Set pNewFeature.Shape = pPolygon
              pNewFeature.Store
            End If
            '
            ' Get the next Feature in the original Polyline FeatureClass.
            '
            Set pFeature = pFeatureCursor.NextFeature
          Loop
          '
          ' After iterating all of the features, stop the editing operation and
          ' save the edits made.
          '
          pNewWorkspaceEdit.StopEditOperation
          pNewWorkspaceEdit.StopEditing True
          '
          ' Add the new FeatureClass to the Map as a layer.
          '
          Dim pNewFeatureLayer As IFeatureLayer
          Set pNewFeatureLayer = New FeatureLayer
          Set pNewFeatureLayer.FeatureClass = pNewFeatureClass
          pNewFeatureLayer.Name = pNewFeatureClass.AliasName
          pMap.AddLayer pNewFeatureLayer
        End If
      End If
    Else
      MsgBox "To use this sample, your data should be part of a GeoDatabase FeatureDataset." _
      & vbNewLine & "You can create a FeatureDataset within ArcCatalog", vbInformation
    End If
  End If
End Sub
            
Private Function fnMakePolygonFields(ByVal pOldFields As IFields, strShapeFieldName As String) As IFields
  '
  ' This function creates a new Fields collection from an existing object,
  ' but changes the Geometry type held to Polylines. We pass in the existing
  ' Fields collection by value to avoid changing the existing Fields.
  '
  If Not pOldFields Is Nothing Then
    Set fnMakePolygonFields = pOldFields
    
    Dim pFieldsEdit As esriCore.IFieldsEdit
    Dim pFieldEdit As IFieldEdit, pField As IField
    Dim pGeomDef As IGeometryDef, pGeomDefEdit As IGeometryDefEdit, lGeom As Long
    '
    ' Find the Field containing the shapes.
    '
    lGeom = fnMakePolygonFields.FindField(strShapeFieldName)
    Set pField = fnMakePolygonFields.Field(lGeom)
    Set pFieldEdit = pField
    '
    ' Copy the current GeometryDefinition, get the GeometryDef editing interface,
    ' and change it to store Polygons.
    '
    Set pGeomDef = pField.GeometryDef
    Set pGeomDefEdit = pGeomDef
    pGeomDefEdit.GeometryType = esriGeometryPolygon
    '
    ' Set the new GeometryDef back to the Shape field.
    '
    With pFieldEdit
      .Name = strShapeFieldName
      .Type = esriFieldTypeGeometry
      Set .GeometryDef = pGeomDef
    End With
    Set pFieldsEdit = fnMakePolygonFields
    Set pFieldsEdit.Field(lGeom) = pFieldEdit
  End If
End Function

Private Function fnHasClosedLines(pFeatClass As IFeatureClass) As Boolean
  fnHasClosedLines = False
  If Not pFeatClass.ShapeType = esriGeometryPolyline Then Exit Function
  '
  ' Check each feature in the FeatureClass to see if any features can be classed as
  ' closed. We could use the ICurve.IsClosed property, but this way we can allow
  ' for a small tolerance in the distance between the FromPoint and ToPoint.
  '
  Dim pFeatureCursor As IFeatureCursor, pFeature As IFeature
  Set pFeatureCursor = pFeatClass.Search(Nothing, False)
  Set pFeature = pFeatureCursor.NextFeature
  '
  ' Iterate all Features.
  '
  Do While Not pFeature Is Nothing
    If fnCurveClosed(pFeature.Shape) Then
      fnHasClosedLines = True
      Exit Function
    End If
    Set pFeature = pFeatureCursor.NextFeature
  Loop
End Function

Private Function fnCurveClosed(pCurve As ICurve) As Boolean
  fnCurveClosed = False
  '
  ' We use the IProximityOperator interface to work out the distance between
  ' the FromPoint and ToPoint of the curve passed in.
  '
  Dim pProxOp As IProximityOperator, dblDist As Double
  Set pProxOp = pCurve.FromPoint
  dblDist = pProxOp.ReturnDistance(pCurve.ToPoint)
  '
  ' This is our tolerance for a 'closed' curve. We could relate this to a snapping
  ' tolerance, or to the spatial reference, or to the size of the shape, instead
  ' of hardcoding the distance.
  '
  If (dblDist < 0.0001) Then fnCurveClosed = True
End Function

Private Function fnPolylineToPolygon(ByVal pPolyline As IPolyline) As IPolygon
  '
  ' This function converts a Polyline to a Polygon, by creating a new Polygon
  ' object and copying the Segments from the Polyline to the new Polygon, and
  ' then ensuring the Polygon is Simple.
  '
  Set fnPolylineToPolygon = New Polygon
  '
  ' Passing the Polyline by value means that we do not need to clone the Polyline.
  '
  Dim pPolygonSegs As ISegmentCollection, pPolylineSegs As ISegmentCollection
  Set pPolygonSegs = fnPolylineToPolygon
  Set pPolylineSegs = pPolyline
  '
  ' Here we copy the Segment objects by using the QuerySegments and AddSegments
  ' methods on the ISegmentCollection interface, which is implemented by both
  ' a Polygon and Polyline coclass.
  '
  Dim pSegs() As ISegment
  ReDim pSegs(pPolylineSegs.SegmentCount - 1) As ISegment
  pPolylineSegs.QuerySegments 0, pPolylineSegs.SegmentCount, pSegs(0)
  If UBound(pSegs) > 0 Then
    pPolygonSegs.AddSegments UBound(pSegs) + 1, pSegs(0)
  End If
  '
  ' The Polygon may have it's rings oriented incorrectly, or have overlapping Rings.
  ' We call simplify here to ensure the new Polygon is Simple, which is a requirement
  ' for adding to a FeatureClass.
  '
  fnPolylineToPolygon.SimplifyPreserveFromTo
End Function