[编程交流] 自动距离

(defun c:LST (/ name file ss ssi enl ln ar ci c2s)
 ;----------------------------
   
   (defun ln (l f) ;To record a LINE l in the file f
   (write-line
       (strcat "LINE,"
           (c2s (cdr (assoc 10 l)))
           (c2s (cdr (assoc 11 l)))
          [b] [color=Red](rtos (* 6.2
                (distance[/color][/b]
                (cdr (assoc 10 l))
                (cdr (assoc 11 l))
                ) ;_  end distance
             ) ;_  end *
           ) ;_  end rtos
       ) ;_  end strcat
       f
   ) ;_  end write-line
   ) ;_  end defun
   
 ;----------------------------
   
   (defun ar (l f / c r u1 u2) ;Record an ARC
   (setq c     (cdr (assoc 10 l)) ;Center
         r     (cdr (assoc 40 l)) ;Radius
         u1 (cdr (assoc 50 l)) ;Start...
         u2 (cdr (assoc 51 l)) ;...and End angle
   ) ;_  end setq
   (write-line
       (strcat "ARC,"
           (c2s (polar c u1 r))
           (c2s (polar c u2 r))
           (rtos (* r (abs (- u2 u1))))
           ","
           (c2s c)
           (rtos r)
       ) ;_  end strcat
       f
   ) ;_  end write-line
   ) ;_  end defun
   
 ;-----------------------------
   
   (defun ci (l f / r) ;To record a CIRCLE
   (setq r (cdr (assoc 40 l))) ;Radius
   (write-line
       (strcat "CIRCLE,,,,,,,"
           (rtos (* 2 PI r))
           ","
           (c2s (cdr (assoc 10 l)))
           (rtos (cdr (assoc 40 l)))
       ) ;_  end strcat
       f
   ) ;_  end write-line
   ) ;_  end defun
   
 ;----------------------------
   
   (defun c2s (x) ;Used to transform Coords in String
   (strcat (rtos (car x)) "," (rtos (cadr x)) "," (rtos (caddr x)) ",")
   ) ;_  end defun
 ;----------------------------
   (setq name (getvar "dwgname"))
   (if    (= "." (substr name (- (strlen name) 3) 1))
   (setq name (substr name 1 (- (strlen name) 4)))
   ) ;_  end if
   (setq file (open (getfiled "Output file..." name "CSV" 1) "w")
     ss   (ssget)
     ssi  -1
   ) ;_  end setq
   (write-line
   "Typ,Start X,Start Y,Start Z,End X,End Y,EndZ,Length,cen X,cen Y,cenZ,Radius"
   file
   ) ;_  end write-line
   (if    ss
   (progn
       (repeat (sslength ss)
       (setq enl (entget (ssname ss (setq ssi (1+ ssi)))))
       (cond
           ((= "LINE" (cdr (assoc 0 enl))) (ln enl file))
           ((= "ARC" (cdr (assoc 0 enl))) (ar enl file))
           ((= "CIRCLE" (cdr (assoc 0 enl))) (ci enl file))
       ) ;_  end cond
       ) ;_  end repeat
   ) ;_  end progn
   ) ;end IF SS
   (close file)
   (princ)
) ;_  end defun