Aşağıda vermiş olduğum Lisp kodu ile bir autocad dosyasındaki hazırlamış olduğunuz tabloları excele aktarır.
(defun c:excel ()
(setvar "cmdecho" 0) (command "undo" "group") (setvar "modemacro" "excel")
(princ "Excel'e aktarmak istediğin tabolyu seç\n")
(while (/= 3 (car (setq ll (grread T 4 0)))) (setq ll (cadr ll)))
(setq ll (list (caadr ll) (cadadr ll)) x1 (car ll) y1 (cadr ll) pp1 nil)
(while (/= 3 (car (setq ur (grread T 4 1))))
(setq ur (list (caadr ur) (cadadr ur)) x2 (car ur) y2 (cadr ur)
pp1 (list x1 y1) pp2 (list x2 y1) pp3 (list x2 y2) pp4 (list x1 y2))
(redraw) (grvecs (list 252 pp1 pp2 pp2 pp3 pp3 pp4 pp4 pp1))) (redraw)
(setq ur (list (caadr ur) (cadadr ur)) dst (/ (distance ur ll) 50.0)
tblcz (ssget "c" ur ll (list (cons 0 "LINE")))
l (sslength tblcz) n 0 xler nil yler nil
f (getfiled "Çıkış Kütüğü" "" "csv" 9) fo (open f "w"))
(while (< n l)
(setq pvt (entget (ssname tblcz n)) n (1+ n)
xler (append (list (cadr (assoc 10 pvt))) xler)
xler (append (list (cadr (assoc 11 pvt))) xler)
yler (append (list (caddr (assoc 10 pvt))) yler)
yler (append (list (caddr (assoc 11 pvt))) yler)))
(setq xler (vl-sort xler '<) yler (vl-sort yler '<)
xmin (nth 0 xler) xmax (nth (- (length xler) 1) xler)
ymin (nth 0 yler) ymax (nth (- (length yler) 1) yler)
p11 (list (- xmin dst) ymin) p12 (list (+ xmax dst) ymax)
p21 (list xmin (- ymin dst)) p22 (list xmax (+ ymax dst)) n 0 xler nil yler nil)
(while (< n l)
(setq pvt (entget (ssname tblcz n))
p3 (list (cadr (assoc 10 pvt)) (caddr (assoc 10 pvt)))
p4 (list (cadr (assoc 11 pvt)) (caddr (assoc 11 pvt)))
dx (abs (- (car p3) (car p4))) dy (abs (- (cadr p3) (cadr p4)))
intx (inters p11 p12 p3 p4) inty (inters p21 p22 p3 p4))
(if intx (if (< dx dy) (setq xler (append (list (car intx)) xler))))
(if inty (if (< dy dx) (setq yler (append (list (cadr inty)) yler))))
(setq n (1+ n)))
(setq xler (vl-sort xler '<) yler (vl-sort yler '>)
yler (append yler (list (- (nth (- (length yler) 1) yler)
(- (nth (- (length yler) 2) yler) (nth (- (length yler) 1) yler)))))
row (- (length yler) 1) clm (- (length xler) 1) n 0 m 0)
(while (< n row)
(setq satir (strcat) mmbr (strcat))
(while (< m clm)
(setq p1 (list (nth m xler) (nth n yler)) p2 (list (nth (1+ m) xler) (nth (1+ n) yler))
cell (ssget "c" p1 p2 (list (cons 0 "TEXT")))
cellm (ssget "c" p1 p2 (list (cons 0 "MTEXT"))))
(if cellm (progn
(if (not cell) (setq cell (ssadd)))
(setq ml (sslength cellm) lm 0)
(while (< lm ml) (setq cell (ssadd (ssname cellm lm) cell) lm (1+ lm)))))
(if cell (progn (setq len (sslength cell) o 0 val (strcat))
(if (> len 1) (progn
(setq grpp (entget (ssname cell o))
grp (list (cadr (assoc 10 grpp)) (cdr (assoc 1 grpp))))
(while (< (setq o (1+ o)) len)
(setq grpp (entget (ssname cell o))
grp (append grp (list (cadr (assoc 10 grpp)) (cdr (assoc 1 grpp))))))
(setq o -1)
(while (< (setq o (1+ o)) (1- len))
(setq p o)
(while (< (setq p (1+ p)) len)
(setq x1 (nth (* 2 o) grp) a1 (nth (+ (* 2 o) 1) grp)
x2 (nth (* 2 p) grp) a2 (nth (+ (* 2 p) 1) grp))
(if (> x1 x2)
(setq grp (subst "xx" x2 grp) grp (subst "aa" a2 grp)
grp (subst x2 x1 grp) grp (subst a2 a1 grp)
grp (subst x1 "xx" grp) grp (subst a1 "aa" grp)))))
(setq o -1)
(while (< (setq o (1+ o)) len)
(setq val (strcat val (nth (+ (* 2 o) 1) grp) " "))))
(setq val (cdr (assoc 1 (entget (ssname cell 0))))))
(setq l1 (strlen val) l2 (strlen mmbr) syc 1 cnt T)
(if (> l1 1)
(while (< syc l2)
(if (wcmatch val (substr mmbr syc l1)) (setq cnt nil)) (setq syc (1+ syc))))
(if cnt (setq satir (strcat satir val) mmbr (strcat mmbr " " val)))
(if (/= m (1- clm)) (setq satir (strcat satir ";"))))
(setq satir (strcat satir ";"))) (setq m (1+ m)))
(write-line satir fo) (setq n (1+ n) m 0))
(close fo)
(princ (strcat "\n\nSeçilen Tablo " f " dosyasına yazıldı..."))
(setvar "modemacro" "") (command "undo" "e") (prin1)
)
Hiç yorum yok:
Yorum Gönder