曲线求取点,利用几何库
<CommandMethod(NameOf(TT_PolyLineCrossCheck))>
Public Sub TT_PolyLineCrossCheck()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
'将用户坐标系转换成世界坐标系
If Application.GetSystemVariable("WORLDUCS").ToString() <> "1" Then
ed.CurrentUserCoordinateSystem = Matrix3d.Identity
ed.Regen()
End If
Try
Dim peo As New PromptEntityOptions("选择第一条PolyLine")
With peo
.SetRejectMessage("only Polyline can be select")
.AddAllowedClass(GetType(Polyline), False)
End With
Dim per1 = ed.GetEntity(peo)
peo.Message = "选择第二条PolyLine"
Dim per2 = ed.GetEntity(peo)
If per1.Status <> PromptStatus.OK Or per2.Status <> PromptStatus.OK Then Return
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim ms As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim c1 As Curve = per1.ObjectId.GetObject(OpenMode.ForRead)
Dim c2 As Curve = per2.ObjectId.GetObject(OpenMode.ForRead)
Dim cur3d1 As Curve3d = c1.GetGeCurve()
Dim cur3d2 As Curve3d = c2.GetGeCurve()
Dim c1Plane = c1.GetPlane()
Dim c2Plane = c2.GetPlane()
If Not c1Plane.IsCoplanarTo(c2Plane) Then
MsgBox("两条曲线不共面无法求取交点", MsgBoxStyle.Critical)
Return
End If
Dim c1c2 As New CurveCurveIntersector3d(cur3d1, cur3d2, c1Plane.Normal)
If c1c2.NumberOfIntersectionPoints > 0 Then '获取交点的个数
For index = 0 To c1c2.NumberOfIntersectionPoints - 1 '提取每个交点的坐标
Dim p As New DBPoint(c1c2.GetIntersectionPoint(index))
ms.AppendEntity(p)
tr.AddNewlyCreatedDBObject(p, True)
Next
tr.Commit()
MsgBox("交点生成成功!")
Else
MsgBox("找不到交点", MsgBoxStyle.Critical)
End If
End Using
Catch ex As System.Exception
Application.ShowAlertDialog(ex.StackTrace)
End Try
End Sub
标签:Dim,AutoCAD,ed,tr,peo,交点,End,VBNET From: https://www.cnblogs.com/NanShengBlogs/p/17743763.html