多义线上一点到起点距离

wlj1118

不知现在还有人在研究这个问题没有，求多义线上一点到起点距离，用GetDistanceAtPoint函数时，一个是很慢，二是提示“错误，参数太少”，请高手帮忙指导。

XDSoft

把完整的代码都贴上，才好方便大家给你提建议。你的错误不一定就是这个函数的语句的地方。

wlj1118

Sub getDistAtPnt()
    '定义引用曲线类模块
    Dim ObjCurve As curve
    Set ObjCurve = New curve
    '获取曲线
    Dim Pnt As Variant
    Dim Ent As AcadLWPolyline
    ThisDrawing.SendCommand "(vl-load-com)" & vbCr
   
   
    ThisDrawing.Utility.GetEntity Ent, Pnt, "选择曲线："
    '保存捕捉模式，并更捕捉模式为最近点捕捉
    Dim SelectMode As Integer
   SelectMode = ThisDrawing.GetVariable("OSMODE")
    ThisDrawing.SetVariable "OSMODE", 512
    '亮显刚选定的曲线以方便捕捉曲线上的点
   On Error Resume Next
    Pnt = ThisDrawing.Utility.GetPoint(, "选择曲线上的一点：")
    '将捕捉模式恢复原先状态

    '通过曲线类模块计算曲线长度
    Set ObjCurve.Entity = Ent
    Dim DistP As Double
    Dim VT As Variant
    Dim VT1(2) As Double
    Dim gpnt As Variant
    Dim Pt(2) As Double
     
     
     gpnt = Ent.Coordinates
   
       Pntcnt = UBound(gpnt)
       Pointnumber = (Pntcnt + 1) / 2
        
        
        ReDim dist(Pointnumber) As Double
        ReDim DistFD(Pointnumber) As Double
        
  
  For i = 1 To Pointnumber
      
      Pt(0) = gpnt(2 * i)
      Pt(1) = gpnt(2 * i + 1)
      Pt(2) = 0
      
      dist(i) = ObjCurve.GetDistanceAtPoint(Pt)
      DistFD(i) = dist(i) - dist(i - 1)
   
   
  Next i

wlj1118

Public Function GetDistanceAtPoint(Point As Variant) As Double

    Dim retval As Double
   
    With objVLAX
        .SetLispSymbol "handle", mvarEntity.Handle
        .SetLispSymbol "point", Point
        retval = .EvalLispExpression("(vlax-curve-getDistAtPoint (handent handle) point)")
        .NullifySymbol "handle", "point"
    End With
    GetDistanceAtPoint = retval

End Function

XDSoft

wlj1118 发表于 2014-9-14 20:35
Public Function GetDistanceAtPoint(Point As Variant) As Double

    Dim retval As Double

虽然不用VBA，但是ARX,LISP和它很多都是相通的，推荐你不要用点去找距离，因为这个点有可能不在曲线上，你得保证点在曲线上程序才不会出错，推荐你用曲线的参数值去求距离， getDistanceAtParam

st788796

这样用太绕了吧，好像前面有引入vlax-curve类方法

wlj1118

XDSoft 发表于 2014-9-14 21:06
虽然不用VBA，但是ARX,LISP和它很多都是相通的，推荐你不要用点去找距离，因为这个点有可能不在曲线上， ...

谢谢，比如我已经通过断面线找到多义线上的交点，只想求这个交点的里程

XDSoft

wlj1118 发表于 2014-9-14 22:42
谢谢，比如我已经通过断面线找到多义线上的交点，只想求这个交点的里程

点在线上，那么 getDistAtPoint 肯定没问题，你最好先 getParamAtPoint 判断下返回值正常，然后 getDistAtParam，有时候你的捕捉设置也会影响到你的程序。

wlj1118

学习了，再试一试，getPointAtDistance这个函数也和前面一样出问题，且问题出在：
Public Function EvalLispExpression(lispStatement As String)

    Dim sym As Object, ret As Object, retval
   
    Set sym = VLF.Item("read").funcall(lispStatement)
   On Error Resume Next
    retval = VLF.Item("eval").funcall(sym)
    If err Then
        EvalLispExpression = ""
    Else
        EvalLispExpression = retval
    End If

End Function
这一段中。