'用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空间 新浪微博 腾讯微博 微信 更多

发表评论 - 不要忘了输入验证码哦！
作者：	用户：  密码：   注册？ 验证：  防止恶意留言请输入问题答案：1*3=?
评论： 禁止表情 禁止UBB 禁止图片 识别链接 识别关键字	表  情