AutoCAD VBNET 曲线求交点

曲线求取点,利用几何库

<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

 

posted @   南胜NanSheng  阅读(109)  评论(0编辑  收藏  举报
相关博文:
阅读排行:
· winform 绘制太阳,地球,月球 运作规律
· 超详细:普通电脑也行Windows部署deepseek R1训练数据并当服务器共享给他人
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· AI 智能体引爆开源社区「GitHub 热点速览」
· 写一个简单的SQL生成工具
点击右上角即可分享
微信分享提示