- 积分
- 19100
- 明经币
- 个
- 注册时间
- 2003-8-16
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
是這樣的, 我寫的這個程序是用來批處理3500個cad文件, 但是不知是什麼原因, 程序剛開始能把文件清理的很小. 但是繼續處理下去時. 接下來的文件會比前面的文件變大了. 暈呀!還望高手指導指導.
(defun c:DGIN(/ dll dwg dnb fdwg texti ss nn tell te1 ted ) (PPPTEST "D:\\shoedwg\\" "dwg") (setq i 0) (SETVAR "CMDECHO" 0) (repeat dll (setq dwg (nth i dwgname )) (setq dnb (strlen (substr dwg 1 (- (strlen dwg) 4)))) (if (<= dnb 7) (setq Fdwg (strcat (substr dwg 1 5) "0" (substr dwg 6 7)))) (IF (= (FINDFILE (strcat"D:\\BDYCADD\\" FDWG)) nil) (PROGN (command ".INSERT" (strcat "D:\\shoedwg\\" dwg )"0,0" "" "" "") (command ".zoom" "e" "") (explode-all);炸開插入的文件 (get-dun-point) (command ".erase" "all" "r" unss "" "") (setq dnb (strlen (substr dwg 1 (- (strlen dwg) 4)))) (if (<= dnb 7) (setq dwg (strcat (substr dwg 1 5) "0" (substr dwg 6 7)))) (setq texti (substr dwg 1 8)) (setq ss (ssget "x" '((0 . "TEXT")))) (setq nn 0) (repeat (sslength ss) ; 循還把七位數的文字改成八位數的文字. (setq te1 (ssname ss nn )) (setq ted (entget te1)) (setq tell (cdr (assoc 1 ted))) (if (> (strlen tell) 2) (progn (if (> (strlen tell) 8) (progn (setq li (substr tell 8 (strlen tell))) (setq texti (strcat texti lI)))) (setq newtext (cons 1 texti)) (setq newok (subst newtext (assoc 1 ted) ted)) (entmod newok))) (setq nn (1+ nn))) (command ".purge" "a" "" "N" ) (command ".saveas" "" (strcat "D:\\BDYCADD\\" dwg )) )) (if (ssget "x") (progn (command ".erase" "all" "") (command ".purge" "a" "" "N" ))) (setq i (1+ i)) ) (princ)) (DEFUN PPPTEST (PPP pd1) (setq ifdiredwg PPP);"C:\\shoe") (SetQ iflistdwg (Cdr (Cdr (VL-Directory-Files ifdiredwg)))) (setq i 0) (setq dwgname (list "")) (setq pd1 (strcat "." pd1)) (setq pd2 (strcase pd1 ));".dwg"); pd2 ".DWG") (repeat (length iflistdwg) (setq dwg (nth i iflistdwg)) (if (> (strlen dwg) 3) (setq hdwg (substr dwg (- (strlen dwg) 3) (strlen dwg)))) (if (or (= hdwg pd1) (= hdwg pd2)) (setq dwgname (append dwgname (list dwg))) ) (setq i (1+ i))) (setq dwgname(cdr dwgname)) (SETQ DLL (length dwgname )) (PRINC) ) ;------------------------------------------------------ (defun explode-all(/ all sl n sd);(explode-all) (setvar "cmdecho" 0) (repeat 2 (setq all(ssget "x") sl (sslength all) n 0) (repeat sl (setq sd (cdr (assoc 0 (entget (ssname all n))))) (if (= sd "INSERT") (command ".explode" (ssname all n))) (setq n (1+ n)))) (setvar "cmdecho" 1) (princ)) ;------------------------------- (defun get-dun-point(/ a as ac af n qend ) (setq a (ssget "x" '((0 . "LWPOLYLINE") (62 . 6)))) (SETQ AS (SSNAME A 0) ac (ENTGET AS) AF (CDR (ASSOC 10 AD))) (setq n 0) (repeat (length ac) (setq qend (nth n ac)) (if (= (car qend) 10) (setq one (cdr qend)) (setq n (1+ n)))) (setq trhee (cdr (nth (+ n 8) ac))) (setq unss (ssget "c" one trhee)) ) |
|