[编程交流] 与偏移和柴对齐

(defun c:Test (/ Text o i n k j ss in l l1 l2 sn e e1 r p pt)
 (vl-load-com)
 ;;; Tharwat 02. Sep. 2012 ;;;
 (defun Text (l l1 l2 / j i pt)
   (setq j 0
         i 0.0
         )
   (repeat (fix (/ l 100.))
     (entmakex (list '(0 . "TEXT")
                     '(40 . 10.0)
                     (cons 1 (strcat (rtos (setq i (+ i 0.1)) 2 1) "Km."))
                     (cons 10 (setq pt (nth j l1)))
                     (cons 11 pt)
                     (cons 50 (setq r (angle (nth j l1) (nth j l2))))
                     )
               )
     (setq j (1+ j))
     )
   )
 (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
   (repeat (setq in (sslength ss))
     (setq o 20.
           n 100.
           k 100.
           )
     (if (> (setq l (vlax-curve-getdistatparam (setq sn (ssname ss (setq in (1- in)))) (vlax-curve-getendparam sn)))
            100.
            )
       (progn (vla-offset (vlax-ename->vla-object sn) o)
              (setq e (entlast))
              (repeat (fix (/ (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 100.))
                (setq l1 (cons (vlax-curve-getpointatdist e n) l1))
                (setq n (+ n k))
                )
              (vla-offset (vlax-ename->vla-object sn) (- o))
              (setq e1 (entlast))
              (setq n 100.)
              (repeat (fix (/ (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1)) 100.))
                (setq l2 (cons (vlax-curve-getpointatdist e1 n) l2))
                (setq n (+ n k))
                )
              (if (< (car (vlax-curve-getstartpoint sn)) (car (vlax-curve-getendpoint sn)))
                (setq l1 (reverse l1)
                      l2 (reverse l2)
                      )
                )
              (Text l l1 l2)
              (entmakex (list '(0 . "TEXT")
                              '(40 . 10.0)
                              (cons 10 (setq pt (vlax-curve-getstartpoint e)))
                              (cons 11 pt)
                              (cons 1 "0.0Km.")
                              (cons 50 r)
                              )
                        )
              (setq e nil
                    i 0.0
                    )
              )
       (princ "\n Polyline is shorter than 100.0 units long !!")
       )
     (setq l1 nil
           l2 nil
           )
     )
   (princ)
   )
 (princ)
 )