Split point results in a zero length polyline - VBA

[LornaMurison]

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

[JamesGraham]

I've used this script before.  My only guess is that there is an instance of where one or more of your points is trying to split the line at the exact location of where one of the line vertices is located. 

My first thought for you would be to grab a subset of the dataset and run it through the script (maybe 1/4 of the lines).  If it works, continue with the other subsets until you generate the error.

Post back the results and any errors you receive.

-J Graham

P.S. Another post a while back had mentioned that they got this error when the two feature classes had different projections.

[LornaMurison]

Hi James, thanks for the reply.
I must have posted this somewhere else as well because I remember someone helping me to find a solution.
I found that even though the points were created from an intersection of the lines, they did not always fall on the line.  My solution was to use a proximity operator to create a point object on the line closest to where the original point is.  I then used that point to split the line.
Here's the edited portion of the code:

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
        
        'Find the point on the line closest to the input point
        Dim pProxOp As IProximityOperator
        Set pProxOp = pPolyCurve
        Dim pProxPoint As IPoint
        Set pProxPoint = pProxOp.ReturnNearestPoint(pPoint, esriNoExtension)

        Dim dblDistTo As Double
        dblDistTo = Sqr(Abs(((Round(pProxPoint.X, 3) - Round(pToPoint.X, 3)) ^ 2) + ((Round(pProxPoint.Y, 3) - Round(pToPoint.Y, 3)) ^ 2)))
        Dim dblDistFrom As Double
        dblDistFrom = Sqr(Abs(((Round(pProxPoint.X, 3) - Round(pFromPoint.X, 3)) ^ 2) + ((Round(pProxPoint.Y, 3) - Round(pFromPoint.Y, 3)) ^ 2)))

        'Show something in status bar
        Dim pStatus As IStatusBar
        Set pStatus = Application.StatusBar
        pStatus.Message(0) = "Splitting at point:" & pointCount & "     " & Int(((pointCount / pointFeatureCount) * 100) + 0.5) & "% done"

        If (Round(pFromPoint.X, 6) = Round(pProxPoint.X, 6) And Round(pFromPoint.Y, 6) = Round(pProxPoint.Y, 6)) Then
            'do nothing
        ElseIf (Round(pToPoint.X, 6) = Round(pProxPoint.X, 6) And Round(pToPoint.Y, 6) = Round(pProxPoint.Y, 6)) Then
            'do nothing
        ElseIf dblDistTo <= 0.0001 Then
            'do nothing
        ElseIf dblDistFrom <= 0.0001 Then
            'do nothing
        Else
            Dim pFeatureEdit As IFeatureEdit
            Set pFeatureEdit = pLineF
            pFeatureEdit.Split pProxPoint
            Debug.Print "split at point " & pointCount
        End If
        Set pLineF = pLineCursor.NextFeature
    Loop
    pointCount = pointCount + 1
    Set pPointF = pPointCursor.NextFeature
Loop

[JamesGraham]

Oh, that's good stuff.  Glad to hear you got your answer and for posting the corrected code!

J Graham