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) ...