[编程交流] 多段线部分的长度

(Defun c:demo (/ p1 p2 obj)
 (and
   (setq p1 (getpoint "\nPick Point A"))
   (setq
     p2 (getpoint p1 "\nPick point B")
   )
   (setq obj (car (nentselp p1)))
   (print (abs        (- (vlax-curve-getdistatpoint
             obj
             (vlax-curve-getclosestpointto obj p1)
           )
           (vlax-curve-getdistatpoint
             obj
             (vlax-curve-getclosestpointto obj p2)
           )
        )
   )
   )
 )(princ)
)

(defun c:Test (/ _LW-p 1p o 2p a b d e)
 ;;    Tharwat 11. Mar. 2014         ;;
 ;;    Measure distance on Polyline by    ;;
 ;;    picking two points        ;;
 (defun _LW-p (p / e o n)
   (if (setq e (ssget p '((0 . "LWPOLYLINE"))))
     (setq o (cdr (assoc -1 (entget (setq n (ssname e 0))))))
   )
   (list o n)
 )
 (if (and (setq 1p (getpoint "\n Specify point on Polyline :"))
          (car (setq o (_LW-p 1p)))
          (setq 2p (getpoint "\n Specify point on the same Polyline :"))
          (if (eq (car o) (car (_LW-p 2p)))
            t
            (alert "You should pick two points on the same polyline ")
          )
     )
   (progn (cond ((equal (setq a (vlax-curve-getdistatpoint (setq e (cadr o)) 1p))
                        (setq b (vlax-curve-getdistatpoint e 2p))
                        1e-8
                 )
                 (setq d 0.)
                )
                (t
                 (if (> a b)
                   (setq d (- a b))
                   (setq d (- b a))
                 )
                )
          )
          (alert (strcat "Distance is : < " (rtos d 2) " > ."))
   )
 )
 (princ)
)
(vl-load-com)