I'm still not sure where the tolerance comes from
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) ...
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
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
Aangemelde leden kunnen berichten plaatsen, updates volgen en meer. Nieuw hier? Registreer een gratis account.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.