Lady_Jane

Split point results in a zero length polyline - VBA

Discussion created by Lady_Jane on Feb 24, 2011
Latest reply on Apr 4, 2011 by jg1295
The code below splits a line feature class everywhere it intersects with a point feature class.

I have run this several times on several different datasets without any problems, but now I am getting the title error.

Points are produced by intersecting line feature class 1 with line feature class 2 and I am trying to split line feature class 1 at those points.  So by definition, the lines and the points intersect.

Briefly, here is how the code works:
Loop through all the points
Find the line(s) that intersect the point
Loop through these lines
If the point has the same coordinates as the line start point, do nothing
If the point has the same coordinates as the line end point, do nothing
else split the line at the point
next line
next point
done

From esri help:
"The error is produced when trying to select a point that is outside of the starting and ending point of the line segment selected. The zero length polyline means that ArcMap based on the point selected with the split tool can not split the selected line anywhere along that line."

Does anyone know how this error could be produced, when a) the point is not at the start or end point of the line, and b) the point necessarily falls somewhere on the line?  Or if the code could be missing any of these situations?

Thank-you!

Private Sub SplitLineAtPoint_Click()

Dim pEditor As IEditor
Set pEditor = Application.FindExtensionByName("ESRI Object Editor")

If pEditor.EditState <> esriStateEditing Then
MsgBox ("Start editing your line feature before proceeding...  ALSO - Make sure the lines you are editing are in a different workspace than your intersecting points.")
        Exit Sub
End If

Dim pEL As IEditLayers
Set pEL = pEditor

If pEL.CurrentLayer.FeatureClass.ShapeType <> esriGeometryPolyline Then
MsgBox ("Target layer must be a line feature.")
Exit Sub
End If

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument

Dim pMap As IMap
Set pMap = pMxDoc.FocusMap

Dim pPointL As IFeatureLayer
Set pPointL = pMap.Layer(0) 'point layer to split lines with

Dim pLineL As IFeatureLayer
Set pLineL = pMap.Layer(1) 'line layer to be split

Dim pLineFC As IFeatureClass
Set pLineFC = pLineL.FeatureClass

Dim pLineGDS As IGeoDataset
Set pLineGDS = pLineFC

Dim pPointFC As IFeatureClass
Set pPointFC = pPointL.FeatureClass 'point feature class to split lines with

Dim pPointCursor As IFeatureCursor
Set pPointCursor = pPointFC.Search(Nothing, False)

Dim pPointF As IFeature
Set pPointF = pPointCursor.NextFeature 'the point feature to split lines with

Dim pointCount As Integer
pointCount = 1
Dim pointFeatureCount As Integer
pointFeatureCount = pPointFC.FeatureCount(Nothing)

Do Until pPointF Is Nothing
Debug.Print pointCount
Dim pPoint As IPoint
Set pPoint = pPointF.Shape
Dim pSF As ISpatialFilter
Set pSF = New SpatialFilter

With pSF
    Set .Geometry = pPoint
    .GeometryField = "Shape"
    .SpatialRel = esriSpatialRelIntersects
End With

Dim pLineCursor As IFeatureCursor
Set pLineCursor = pLineFC.Search(pSF, False)

Dim pLineF As IFeature
Set pLineF = pLineCursor.NextFeature

Do Until pLineF Is Nothing
Dim pPolyCurve As IPolycurve
Set pPolyCurve = pLineF.Shape

Dim pToPoint As IPoint
Set pToPoint = pPolyCurve.ToPoint 'end point of the line

Dim pFromPoint As IPoint
Set pFromPoint = pPolyCurve.FromPoint  'start point of the line
'Debug.Print Round(pToPoint.X, 7), Round(pToPoint.Y, 7)
'Debug.Print Round(pFromPoint.X, 7), Round(pFromPoint.Y, 7)
'Debug.Print Round(pPoint.X, 7), Round(pPoint.Y, 7)

'Show something in status bar
Dim pStatus As IStatusBar
Set pStatus = Application.StatusBar
pStatus.Message(0) = "Splitting at point:" & pointCount & "     " & ((pointCount / pointFeatureCount) * 100) & "% done"
If (Round(pFromPoint.X, 6) = Round(pPoint.X, 6) And Round(pFromPoint.Y, 6) = Round(pPoint.Y, 6)) Then  'do nothing
ElseIf (Round(pToPoint.X, 6) = Round(pPoint.X, 6) And Round(pToPoint.Y, 6) = Round(pPoint.Y, 6)) Then  'do nothing
Else
    Dim pFeatureEdit As IFeatureEdit
    Set pFeatureEdit = pLineF
    pFeatureEdit.Split pPointF.Shape
End If
Set pLineF = pLineCursor.NextFeature
Loop
pointCount = pointCount + 1
Set pPointF = pPointCursor.NextFeature
Loop

MsgBox ("Lines have been split at intersecting points..." & vbNewLine & vbNewLine & "SAVE Your EDITS before closing..")

End Sub

Outcomes