AutoCAD VBNET 曲线求交点-526互联

曲线求取点，利用几何库

<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

交点