[编程交流] 测量a线的Lisp例程

(defun c:test (/ ss ss1 e d lens adds e1 )
 ; Tharwat 14.02.2011
 (setq lens 0)
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (progn
     (repeat (setq i (sslength ss))
   (while
     (setq ss1 (ssname ss  (setq i (1- i))))
      (setq e (entget ss1))
       (setq d (distance (cdr (assoc 10 e))(cdr (assoc 11 e))))
        (setq lens (+ lens d))
         ))
     (setq adds (entsel "\n Select Text to add lengths to :"))
     (entupd (cdr (assoc -1 (entmod (subst
                      (cons 1 (strcat (cdr (assoc 1 (setq e1 (entget (car adds)))))
                               " = " (rtos lens 4 5)))
                      (assoc 1 e1) e1 )))))
     )
   (princ "\n No lines selected")
   )
 (princ)
 )

(rtos lens 4 5)

(rtos lens 2 5)

(defun c:test (/ ss i sn e e1 ent lens)
; Tharwat 07.10.2012   ;;;
 (setq lens 0)
 (prompt "\n Select lines ...")
 (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
          (progn
            (prompt
              "\n Select text object to replace lengths of lines :"
            )
            (setq e (ssget "_+.:S:L" '((0 . "*TEXT"))))
          )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (setq ent (entget sn))
       (setq
         lens (+ lens
                 (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent)))
              )
       )
     )
     (entupd
       (cdr
         (assoc
           -1
           (entmod
             (subst
               (cons
                 1
                 (strcat "Lengths = "
                         (rtos lens 2 5)
                 )
               )
               (assoc 1 (setq e1 (entget (ssname e 0))))
               e1
             )
           )
         )
       )
     )
   )
   (cond ((not ss) (princ "\n No lines selected"))
         (t (princ "\n Selection is not Text or nothing selected"))
   )
 )
 (princ)
)