用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

分享到： QQ空间新浪微博腾讯微博微信更多

暂时没有评论

发表评论 - 不要忘了输入验证码哦！

作者：

用户：密码：注册？验证：