|
|
Public Shared Sub xj_trim(ByVal PL As Polyline)
Dim doc As Document = Autodesk..ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim p3dCOL As New Point3dCollection
p3dCOL = ModelSpace.getplCollection(PL) '获取线顶点集合
Dim res As PromptSelectionResult = ed.SelectFence(p3dCOL)
If res.Status PromptStatus.OK Then Exit Sub
Dim sset As SelectionSet = res.Value
Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False)
For i As Integer = 0 To sset.Count - 1 '遍历
Dim fobj As FenceSelectedObject = sset(i)
Dim fent As Entity = trans.GetObject(fobj.ObjectId, OpenMode.ForWrite)
If TypeOf (fent) Is Curve Then
' //获取被栏选的直线和栏选点
Dim pCurve As Curve = trans.GetObject(fobj.ObjectId, OpenMode.ForWrite) '相交曲线
Dim ppd As Point3d = fobj.GetIntersectionPoints()(0).PointOnLine
pCurve.UpgradeOpen()
Dim P3C As New Point3dCollection
'//获取直线和偏移界线的交点集合
pCurve.IntersectWith(PL, Intersect.ExtendArgument, P3C, 0, 0) '获取交点集合
If P3C Is Nothing Then GoTo ii
Dim plist As New List(Of Double)
For Each pp As Point3d In P3C
plist.Add(pCurve.GetParameterAtPoint(pCurve.GetClosestPointTo(pp, False))) '获取交点最近点
Next
If (plist Is Nothing) Then GoTo ii
plist.Sort() '排序
Dim dcol As New DoubleCollection(plist.ToArray())
Try
For Each cc As Curve In pCurve.GetSplitCurves(dcol) '曲线打断
Debug.Print(cc.StartPoint.X & "," & cc.EndPoint.X) '显示曲线分段首尾x坐标 完全正确
' 将图形对象的信息添加到块表记录中,
btr.AppendEntity(cc)
' 把图形对象添加到事务处理中.
trans.AddNewlyCreatedDBObject(cc, True)
Next
' pCurve.Erase()
Catch ex As Exception '出错
Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(ex.Message + "\n" + ex.StackTrace)
End Try
End If
ii: Next i
trans.Commit()
End Using
End Sub
|
|
置顶卡
