Multipart polyline to single part lines

Breaking Up Polylines 

http://forums.esri.com/Thread.asp?c=93&f=987&t=74554&mc=4#msgid197545

 

It appears as though IGeometryCollection is the way to go here, rather than ISegmentCollection. I noticed that the "ISegmentCollection" version created 905 line segments (from 15 polylines). ISegmentCollection created a line for every Single PAIR of vertices - 905 straight, two vertex lines. 

There is no way I could have put this thing together at this point. Thanks for getting the ball rolling. 

Hopefully, this can be useful to other users. Multipart lines can be a huge pain when you don't want them. 

Sub ExplodePolyLines()

'

' From the original by Kirk Kuykendall.

'

Dim pUID As New UID

pUID.Value = "esricore.Editor"

 

Dim pEditor As IEditor

Set pEditor = Application.FindExtensionByCLSID(pUID)

 

If pEditor.EditState <> esriStateEditing Then

MsgBox "Make a shapefile editable."

Exit Sub

End If

 

Dim pEditlayers As IEditLayers

Set pEditlayers = pEditor

 

If pEditlayers.CurrentLayer.FeatureClass.ShapeType <> esriGeometryPolyline Then

Exit Sub

End If

 

Dim pFSel As IFeatureSelection

Set pFSel = pEditlayers.CurrentLayer

 

If pFSel.SelectionSet.Count = 0 Then

MsgBox "Select features to be broken up."

Exit Sub

End If

 

Dim pFCur As IFeatureCursor

pFSel.SelectionSet.Search Nothing, False, pFCur

 

pEditor.StartOperation

Dim pFeat As IFeature

Set pFeat = pFCur.NextFeature

Do Until pFeat Is Nothing

Dim pInGeomColl As IGeometryCollection

''' Dim pInSegColl As ISegmentCollection

''' Set pInSegColl = pFeat.ShapeCopy

Set pInGeomColl = pFeat.ShapeCopy

 

Application.StatusBar.Message(0) = "Exploding " & pFeat.OID

Dim l As Long

''' For l = 0 To pInSegColl.SegmentCount - 1

For l = 0 To pInGeomColl.GeometryCount - 1

''' Dim pOutSegColl As ISegmentCollection

''' Set pOutSegColl = New Polyline

Dim pOutGeomColl As IGeometryCollection

Set pOutGeomColl = New Polyline

''' pOutSegColl.AddSegment pInSegColl.Segment(l)

pOutGeomColl.AddGeometry pInGeomColl.Geometry(l)

Dim pOutFeat As IFeature

Set pOutFeat = pEditlayers.CurrentLayer.FeatureClass.CreateFeature

Dim k As Long

For k = 0 To pOutFeat.Fields.FieldCount - 1

If pOutFeat.Fields.Field(k).Editable Then

If pOutFeat.Fields.Field(k).Type <> esriFieldTypeGeometry Then

pOutFeat.Value(k) = pFeat.Value(k)

End If

End If

Next k

''' Set pOutFeat.Shape = pOutSegColl

Set pOutFeat.Shape = pOutGeomColl

pOutFeat.Store

Next l

pFeat.Delete

Set pFeat = pFCur.NextFeature

Loop

pEditor.StopOperation "Explode"

 

Dim pMxDoc As IMxDocument

Set pMxDoc = pEditor.Parent.Document

Dim pAV As IActiveView

Set pAV = pMxDoc.FocusMap

Dim lCacheID As Long

lCacheID = pAV.ScreenCacheID(esriViewGeoSelection, Nothing)

pAV.ScreenDisplay.Invalidate Nothing, True, lCacheID

MsgBox "Done"

End Sub