怎样得到多段线上一点处的曲率？

弯弯

请教高手，怎样得到多段线上一点处的曲率？

什么函数可以实现呢

最好有C#的代码。

呵呵，不胜感激！

ntchjie

我也曾经疑惑过很长时间。看看下面代码吧：vbnet的，自己转下。

<CommandMethod("testcut")> _
     Public Sub cut()
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim ts As String = vbCr & "请选择线条（圆弧、直线或者多义线）："
        Dim opt As New PromptEntityOptions(ts)
        opt.SetRejectMessage(vbCr & "只能线条")
        opt.AddAllowedClass(GetType(Polyline), True)
        opt.AddAllowedClass(GetType(Arc), True)
        opt.AddAllowedClass(GetType(Line), True)
        Dim res As PromptEntityResult = ed.GetEntity(opt)
        If res.Status <> PromptStatus.OK Then
            ed.WriteMessage("用户自行退出！" & vbCr)
        Else
            '获取等分数
            Dim iop As New PromptIntegerOptions("指定等分段的数量：")
            iop.DefaultValue = 10
            Dim irt As PromptIntegerResult = ed.GetInteger(iop)
            Dim n As Integer
            If irt.Status <> PromptStatus.OK orElse irt.Value < 2 Then
                Return
            Else
                n = irt.Value
            End If
            Dim entid As ObjectId = res.ObjectId
            Using trans As Transaction = db.TransactionManager.StartTransaction()
                '得到拾取的对象
                Dim ent As Entity = trans.GetObject(entid, OpenMode.ForRead)
                Dim cv As Curve = DirectCast(trans.GetObject(ent.ObjectId, OpenMode.ForWrite), Curve)
                Dim len As Double = cv.GetDistanceAtParameter(cv.EndParam)
                Dim i As Integer
                For i = 0 To n
                    Dim p As Point3d = cv.GetPointAtDist(i * len / n)
                    Dim kp As Object = cv.GetFirstDerivative(cv.GetParameterAtDistance(i * len / n))
                    Dim ka As Double = kp(1) / kp(0) - Math.PI / 2
                    Call AddText(p, "等分点" & CStr(i), 3, ka, 1, 1)
                Next
                trans.Commit()
            End Using
        End If
    End Sub
    ' 由插入点、文字内容、文字高度和倾斜角度创建单行文字的函数.
    ublic Function AddText(ByVal position As Point3d, ByVal textString As String, ByVal height As Double, ByVal rotate As Double, ByVal dq As Integer, ByVal co As Integer) As ObjectId
        'position为文字位置，textstring为文字内容，height为文字高度，rotate为文字角度，dq为对齐方式,co为颜色
        Try
            Dim ent As New DBText()
            ent.Position = position
            ent.TextString = textString
            ent.Height = height
            ent.Rotation = rotate
            ent.ColorIndex = co
            Select Case dq
                Case 0
                    ent.HorizontalMode = TextHorizontalMode.TextMid
                Case 1
                    ent.HorizontalMode = TextHorizontalMode.TextLeft
                    ent.VerticalMode = TextVerticalMode.TextVerticalMid
            End Select
            ent.AlignmentPoint = position
            Dim entId As ObjectId = AppendEntity(ent)
            Return entId
        Catch
            ' 创建失败,则返回一个空的ObjectId.
            Dim nullId As ObjectId = ObjectId.Null
            Return nullId
        End Try
    End Function
    ' 将图形对象加入到模型空间的函数.
    ublic Function AppendEntity(ByVal ent As Entity) As ObjectId
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim entId As ObjectId
        Using trans As Transaction = db.TransactionManager.StartTransaction
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
            entId = btr.AppendEntity(ent)
            trans.AddNewlyCreatedDBObject(ent, True)
            trans.Commit()
        End Using
        Return entId
    End Function

弯弯

谢谢热心肠的ntchjie先生，我试试看...

yanglin112

学习了！Mark