[求助]：如何实现多义线长度逐段累加赋值？

jinsong-liao

一条多义线，如何实现长度逐段累加赋值，ACADLISP代码如何编写？
  求得第二个顶点到 第一个顶点长度 赋值给变量pt2－length
   求得第三个顶点到 第一个顶点长度（前两段长度之和，非1.3顶点直线距离）
                                赋值给变量pt3－length
   依次类推，直至终点
   难者不会，会者不难。
  请大家指点，谢谢！！！

xyp1964

没cad和VL编辑器，无法测试！
请哪位测试和完善！
[php]
(defun c:test ()
   (setq s1 (entsel "\n\t选择对象<退出> : ")
            eobj (vlax-ename->vla-object (car s1))
            i -1
            Leng 0)
   (while (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
             (if (setq pt1 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))
                (setq  Leng (+ Leng (distance pt0 pt1))))
            (princ Leng)
  )
)
[/php]

LADESIGNER

AUTOLISP(ONLY FOR LWPOLYLINE):
(DEFUN C:TEST ()
  (SETQ EN (ENTSEL "\nSELCET LWPOLYLINE:"))
  (SETQ ENLIST (ENTGET (CAR EN)) PTZBS '())
  (FOREACH X ENLIST
    (PROGN
      (IF (EQUAL (CAR X) 10)
        (SETQ PTZBS (CONS (CDR X) PTZBS))
      )
    )
  )
  (SETQ ptzbs(reverse ptzbs)
        N 0
        TEMP 0
  )
  (REPEAT (- (LENGTH PTZBS) 1)
    (SETQ DIS (DISTANCE (NTH N PTZBS) (NTH (1+ N) PTZBS)))
    (SETQ TEMP (+ TEMP DIS))
    (PRINC "\n")
    (SET (READ (STRCAT "PT" (RTOS (1+ N)) "-LENGTH")) TEMP)
    (setq n(+ n 1))
    )
)

测试；
!pt1-length 6804.5
!pt2-length 12364.2
..................

jinsong-liao

3楼楼主的代码满足我的要求
将 (RTOS (1+ N)) 改为(RTOS (1+ N) 2 0) 更好点
非常感谢二位！！！

xyp1964

2004测试通过：
[php]
;;;多义线长度逐段累加赋值
(defun c:test025 ()
  (setq        s1   (entsel "\n\t选择对象<退出> : ")
        eobj (vlax-ename->vla-object (car s1))
        i    -1
        Leng 0
  )
  (while (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
    (if        (setq pt1 (vlax-curve-getPointAtParam eobj (setq n (1+ i))))
      (progn
        (setq Leng (+ Leng (distance pt0 pt1)))
        (princ (strcat "\nLeng" (rtos i 2 0) " = "))
        (princ Leng)
      )
    )
  )
  (princ)
)
[/php]
命令: test025

选择对象<退出> :
Leng0 = 4255.81
Leng1 = 7819.32
Leng2 = 10949.4
Leng3 = 14010.9
Leng4 = 16554.0
Leng5 = 19315.1
Leng6 = 22812.0
Leng7 = 25700.1

梦断江南

改一下xyp兄的程序，简化一点，并且支持含弧段的多义线
[php]
;;;多义线长度逐段累加赋值
(defun c:tt (/ e i n )
  (setq e (car(entsel "\n\t选择对象<退出> : ") );;可加实体判断，略.
        i 0
        n (vlax-curve-getendParam e)
  )
  (while (<= (setq i (1+ i)) n)
    (mapcar 'princ (list "\nLeng" i " = " (vlax-curve-getdistAtParam e i)))
  )
  (princ)
)[/php]