[编程交流] 沿多段线w测量块

(defun c:Test  (/ blk s e l d v)
 ;; Tharwat 07.Feb.2016 ;;
 (setq blk "CATCH_PIT")
 ;; Block name
 (if (and (tblsearch "BLOCK" blk)
          (princ "\nSelect LWpolyline :")
          (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (setq l (vlax-curve-getdistatpoint
                    (setq e (ssname s 0))
                    (vlax-curve-getendpoint e))))
   (while
     (and
       (setq d
              (getdist
                (strcat "\nSpecify distance less than "
                        (rtos l 2 2)
                        " > :")
                )
             )
       (< d l)
       (/= "" (setq v (getstring t "\nSpecify Attribute Value :")))
       )
      (entmake
        (list '(0 . "INSERT")
              (cons 10 (vlax-curve-getpointatdist e d))
              (cons 50
                    (+ (* pi 0.5)(angle '(0. 0. 0.)
                           (vlax-curve-getfirstderiv
                             e
                             (vlax-curve-getparamatpoint
                               e
                               (vlax-curve-getpointatdist e d))))))                     
              (cons 2 blk)
              )
        )
      (if (> d l)
        (alert "\nLong distance entered !")
        )
      )
   )
 (princ)
 )(vl-load-com)