Is This Content Helpful?
How can we make this better? Please provide as much detail as possible.
Note: This article pertains to ArcGIS versions 8.x and 9.x. Later versions of ArcGIS may contain different functionality, as well as different names and locations for menus, commands and geoprocessing tools.
This article contains an ArcObjects code sample that demonstrates how to split a polyline at the vertices, creating separate lines from each line segment.
Note: Support for Visual Basic for Applications (VBA) for ArcMap and ArcCatalog ended with the ArcGIS 10.2.2 release, and Esri has not included VBA compatibility setups since version 10.5. See: ArcGIS Desktop and VBA Moving Forward
Note: For more information on creating a UIControl, see the ArcGIS Desktop Help topic: 'Creating custom commands with VBA and UI Controls'
Dim pMxDoc As IMxDocument Dim pFeatureClass As IFeatureClass Dim pFeatureLayer As IFeatureLayer Dim pFeatureCursor As IFeatureCursor Dim pOutFeatureCursor As IFeatureCursor Dim pFeature As IFeature Dim pOutFeatureBuffer As IFeatureBuffer Dim pSegmentCollection As ISegmentCollection Dim pSegment As ISegment Dim pPointCollection As IPointCollection Dim i As Integer Dim index As Integer Dim numFeatures As Integer 'Split lines for selected layer Set pMxDoc = ThisDocument If Not pMxDoc.SelectedLayer Is Nothing Then Set pFeatureLayer = pMxDoc.SelectedLayer Else MsgBox "Please select layer to split" Exit Sub End If Set pFeatureClass = pFeatureLayer.FeatureClass Set pFeatureCursor = pFeatureClass.Update(Nothing, False) Set pOutFeatureCursor = pFeatureClass.Insert(True) Set pFeature = pFeatureCursor.NextFeature numFeatures = pFeatureClass.FeatureCount(Nothing) 'Loop through the features and split each feature at 'it's vertices then copy attributes and shape to new feature For index = 0 To numFeatures - 1 Set pSegmentCollection = pFeature.Shape For i = 0 To pSegmentCollection.SegmentCount - 1 Set pSegment = pSegmentCollection.Segment(i) Set pOutFeatureBuffer = pFeatureClass.CreateFeatureBuffer AddFields pOutFeatureBuffer, pFeature Set pPointCollection = New Polyline pPointCollection.AddPoint pSegment.FromPoint pPointCollection.AddPoint pSegment.ToPoint Set pOutFeatureBuffer.Shape = pPointCollection pOutFeatureCursor.InsertFeature pOutFeatureBuffer Next i pFeatureCursor.DeleteFeature Set pFeature = pFeatureCursor.NextFeature pOutFeatureCursor.Flush Next index pFeatureCursor.Flush 'Refresh pMxDoc.ActiveView.Refresh MsgBox ("Completed!") End Sub
Private Sub AddFields(pFeatureBuffer As IFeatureBuffer, pFeature As IFeature) 'Copy the attributes from the original feature to the new one Dim pRowBuffer As IRowBuffer Dim pNewFields As IFields Dim pNewField As IField Dim pFields As IFields Dim pField As IField Dim i As Integer Dim NewFieldIndex As Long Set pRowBuffer = pFeatureBuffer Set pNewFields = pRowBuffer.Fields Set pFields = pFeature.Fields For i = 0 To pFields.FieldCount - 1 Set pField = pFields.Field(i) If Not pField.Type = esriFieldTypeGeometry And Not pField.Type = esriFieldTypeOID And pField.Editable Then NewFieldIndex = pNewFields.FindField(pField.Name) If Not NewFieldIndex = -1 Then pFeatureBuffer.Value(NewFieldIndex) = pFeature.Value(i) End If End If Next End Sub