用PL2将PL1线打断后,删除PL2内部部分,保留外部部分
'用PL2将PL1线打断后,删除PL2内部部分,保留外部部分
<CommandMethod("PLBreak")> _
Public Sub PLBreak()
On Error Resume Next
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Dim acTypValAr(0) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "LWPOLYLINE"), 0)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection(acSelFtr)
If acSSPrompt.Status = PromptStatus.OK Then '选择成功
Dim acSSet As SelectionSet = acSSPrompt.Value
Dim Pts As Point3dCollection = New Point3dCollection
Dim PL1 As Polyline = acTrans.GetObject(acSSet.Item(0).ObjectId, OpenMode.ForWrite) '打断PL1
Dim PL2 As Polyline = acTrans.GetObject(acSSet.Item(1).ObjectId, OpenMode.ForWrite)
PL1.IntersectWith(PL2, Intersect.ExtendBoth, New Plane, Pts, 0, 0)
Dim Dbs As DBObjectCollection = PL1.GetSplitCurves(Pts)
'打断后,删除PL2内的部分,保留PL2外部部分
For Each E As Entity In Dbs
If E.GeometricExtents.MinPoint.X < PL2.GeometricExtents.MinPoint.X _
Or E.GeometricExtents.MinPoint.Y < PL2.GeometricExtents.MinPoint.Y _
Or E.GeometricExtents.MaxPoint.X > PL2.GeometricExtents.MaxPoint.X _
Or E.GeometricExtents.MaxPoint.Y > PL2.GeometricExtents.MaxPoint.Y Then
AddEnt(E)
End If
Next
PL1.Erase()
acTrans.Commit()
End If
End Using
If Err.Number > 0 Then
MsgBox(Err.Description)
End If
End Sub
Please follow WeChat's public account ByCAD