I do have this code with me, but it doesn't working for pline which is not closed.
;| Program to export properties of ARC, CIRCLE and LINE entities
into a CSV file
mfuccaro@hotmail.com
the UNIT command should use before using this lisp
---------------------------August 2004
|;
;REVISIONS: September 2004
; - Added CIRCLES to the list
; - Length calculation for all recorded entities
; - Handle the error if nothing is selected
;
;January 2010
; - numbering entities
(defun putno(n p)
(setq txtheight 200)
(entmake (list '(0 . "TEXT") (cons 1 (rtos n)) (cons 10 p) (cons 40 txtheight) '(50 . 0.78539))
(eval n)
)
(defun c:LST( / name file ss ssi enl ln ar ci c2s)
;----------------------------
(defun ln (l f n / p) ;To record a LINE l in the file f
(write-line (strcat "LINE,"
(c2s (cdr (assoc 10 l)))
(c2s (cdr (assoc 11 l)))
(rtos (distance
(cdr (assoc 10 l))
(cdr (assoc 11 l))))) f)
(setq p (mapcar '* (mapcar '+ (cdr (assoc 10 l)) (cdr (assoc 11 l))) '(0.5 0.5 0.5)))
(putno n p)
)
;----------------------------
(defun ar (l f n / 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
)
(write-line (strcat "ARC,"
(c2s (polar c u1 r))
(c2s (polar c u2 r))
(rtos (* r (abs (- u2 u1)))) ","
(c2s c) (rtos r)) f)
(putno n c)
)
;-----------------------------
(defun ci (l f n / 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)))) f)
(putno n (cdr (assoc 10 l)))
)
;----------------------------
(defun c2s (x) ;Used to transform Coords in String
(strcat (rtos (car x)) "," (rtos (cadr x)) "," (rtos (caddr x)) ",")
)
;----------------------------
(setq name (getvar "dwgname"))
(if (= "." (substr name (- (strlen name) 3) 1))
(setq name (substr name 1 (- (strlen name) 4))))
(setq file (open (getfiled "Output file..." name "CSV" 1) "w")
ss (ssget) ssi -1)
(write-line
"Type,Start X,Start Y,Start Z,End X,End Y,EndZ,Length,cen X,cen Y,cenZ,Radius"
file)
(setq n 1)
(if ss
(progn
(repeat (sslength ss)
(setq enl (entget (ssname ss (setq ssi (1+ ssi)))))
(cond
((= "LINE" (cdr (assoc 0 enl))) (ln enl file (setq n (1+ n))))
((= "ARC" (cdr (assoc 0 enl))) (ar enl file (setq n (1+ n))))
((= "CIRCLE" (cdr (assoc 0 enl))) (ci enl file (setq n (1+ n))))
)
))) ;end IF SS
(close file)
(princ)
)




Reply With Quote
))
Bookmarks