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
Debug.Print pointCount
Dim pointFeatureCount As Integer
pointFeatureCount = pPointFC.FeatureCount(Nothing)
Do Until pPointF Is Nothing
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 ' <---- The problem lines don't get past this point
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
'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
Debug.Print "split at point " & pointCount
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
Do Until pPointF Is Nothing Dim pPoint As IPoint Set pPoint = pPointF.Shape Dim topoOp As ITopologicalOperator Set topoOp = pPoint Dim bufferPoly As IPolygon Set bufferPoly = topoOp.Buffer(pMxDoc.SearchTolerance) Dim pSF As ISpatialFilter Set pSF = New SpatialFilter With pSF Set .Geometry = bufferPoly .GeometryField = "Shape" .SpatialRel = esriSpatialRelIntersects End With
Do Until pPointF Is Nothing Dim pPoint As IPoint Set pPoint = pPointF.Shape Dim pTopoOp As ITopologicalOperator Set pTopoOp = pPoint Dim BufferPoly As esriGeometry.IPolygon Set BufferPoly = pTopoOp.Buffer(pMxDoc.SearchTolerance) ...