Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Namespace CurveTesting
    Public Class Commands
        <CommandMethod("POC")> _
        Public Sub PointOnCurve()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            Dim peo As New PromptEntityOptions(vbLf & "选择一条曲线:")
            peo.SetRejectMessage("选择一条曲线:")
            peo.AddAllowedClass(GetType(Curve), False)

            Dim per As PromptEntityResult = ed.GetEntity(peo)
            If per.Status <> PromptStatus.OK Then
                Return
            End If

            Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "选择一个点;")
            If ppr.Status <> PromptStatus.OK Then
                Return
            End If

            Dim tr As Transaction = db.TransactionManager.StartTransaction()
            Using tr
                Dim curve As Curve = TryCast(tr.GetObject(per.ObjectId, OpenMode.ForRead), Curve)
                If curve IsNot Nothing Then
                    Dim isOn As Boolean = IsPointOnCurveGCP(curve, ppr.Value)
                    If isOn = True Then
                        ed.WriteMessage(vbLf & "所选点在曲线上。")
                    Else
                        ed.WriteMessage(vbLf & "所选点不在曲线上。")
                    End If
                End If
                tr.Commit()
            End Using

        End Sub

        '函数 IsPointOnCurveGDAP 适用与所有类型的曲线（包括折线）
        Private Function IsPointOnCurveGDAP(ByVal cv As Curve, ByVal pt As Point3d) As Boolean
            Try
                '点在曲线上,就能得到GetDistAtPoint的值 ,返回True
                cv.GetDistAtPoint(pt)
                'MsgBox(cv.GetDistAtPoint(pt).ToString)
                Return True
            Catch
            End Try
            '点不在曲线上, 出错 ,返回False
            Return False

        End Function

        '函数 IsPointOnCurveGCP 适用与所有类型的曲线（包括折线）
        Private Function IsPointOnCurveGCP(ByVal cv As Curve, ByVal pt As Point3d) As Boolean
            Try
                '点到曲线最近点
                Dim p As Point3d = cv.GetClosestPointTo(pt, False)
                '两点距离在容差范围内
                Return (p - pt).Length <= Tolerance.[Global].EqualPoint
            Catch
            End Try
            Return False
        End Function
    End Class
End Namespace

  Private Function IsPointOnPolyline(ByVal pl As Polyline, ByVal pt As Point3d) As Boolean
            Dim isOn As Boolean = False
            For i As Integer = 0 To pl.NumberOfVertices - 1
                Dim seg As Curve3d = Nothing
                '线段
                Dim segType As SegmentType = pl.GetSegmentType(i)

                If segType = SegmentType.Arc Then '线段是圆弧
                    seg = pl.GetArcSegmentAt(i)
                ElseIf segType = SegmentType.Line Then '线段是直线段
                    seg = pl.GetLineSegmentAt(i)
                End If
                '使用IsOn函数判断点是否在线段上
                If seg IsNot Nothing Then
                    isOn = seg.IsOn(pt)
                    If isOn Then
                        Exit For
                    End If
                End If
            Next
            Return isOn
        End Function