小编点评

**曲线求取点** **步骤：** 1. **获取用户坐标系：**确保应用程序已设置正确的世界坐标系。 2. **获取两个 PolyLine 对象：**使用 `PromptEntityOptions` 获取第一个和第二个 PolyLine 对象。 3. **检查曲线平面的交点数量：**如果两个曲线平面不共面，则无法求取交点。 4. **求取交点：**如果平面的交点数量大于 0，则使用 `CurveCurveIntersector3d` 类计算交点。 5. **绘制交点：**将交点坐标添加到 BlockTable 中。 6. **提交 transaction：**将交点记录到数据库中。 7. **显示结果：**显示交点生成成功的信息。 **代码示例：** ```vba 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 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) Dim peo2 As New PromptEntityOptions("选择第二条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 As Curve = c1.GetPlane() Dim c2Plane As Curve = 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) Next tr.Commit() MsgBox("交点生成成功!\") Else MsgBox("找不到交点", MsgBoxStyle.Critical) End If End Using End Sub ```

正文

曲线求取点，利用几何库

<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