高手帮助，来个自动炸尺寸的程序

asdfghjksz

本人有很多小CAD文件，现在需要一个个打开后，把里面的尺寸炸开，然后合并到一个CAD。
现想，1 能否有批量炸图的程序，能选择所有文件炸
2. 文件打开后，自动选择所有尺寸，炸开后保存关闭。
以上2种方法，哪位高手会折腾个LISP下来，将非常感谢！！

Gu_xl

1. ;;;批处理函数框架
   
2. (defun batchCommand (path fun / files doc)
   
3.   (setq files (vl-directory-files path "*.dwg" 1))
   
4.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
   
5.   (foreach dwgname files
   
6.    (setq dwgname (strcat path "\\" dwgname))
   
7.     (if (/= (strcase dwgname) (strcase (strcat (getvar "dwgprefix") dwgname)))
   
8.       (progn
   
9.     (if (= 8 (logand 8 (getvar 'UNDOCTL)))
   
10.       (vla-EndUndoMark doc)
    
11.     )
    
12.     (vla-StartUndoMark doc)
    
13.     (setvar "clayer" "0")
    
14.     (command "-layer" "u" "*" "t" "*" "")
    
15.     (command "insert" dwgname '(0 0 0) 1 1 0)
    
16.     (command "explode" (entlast))
    
17.     (command "-layer" "u" "*" "t" "*" "")
    
18.     ;;;处理动作
    
19.     (VL-CATCH-ALL-APPLY (FUNCTION fun))
    
20.     ;;;回写文件
    
21.     (command "wblock" dwgname "*")
    
22. 
    
23.     (if (= 8 (logand 8 (getvar 'UNDOCTL)))
    
24.       (vla-EndUndoMark doc)
    
25.     )
    
26.     (command  "_u")
    
27.     )
    
28.       )
    
29.     )
    
30.   )
    
31. ;;;炸DIM
    
32. (defun burstdim (/ qa ss)
    
33.   (setq qa (getvar "QAFLAGS"))
    
34.   (setvar "QAFLAGS" 1)
    
35.   (setq ss (ssget "x" '((0 . "*DIMENSION"))))
    
36.   (if ss (command "explode" ss ""))
    
37.   (setvar "QAFLAGS" qa)
    
38.   )
    
39. ;;;取文件夹
    
40. (defun getFolder (msg / WinShell shFolder path catchit)
    
41.   (setq winshell (vlax-create-object "Shell.Application"))
    
42.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    
43.   (setq
    
44.     catchit (vl-catch-all-apply
    
45.               '(lambda ()
    
46.                  (setq shFolder (vlax-get-property shFolder 'self))
    
47.                  (setq path (vlax-get-property shFolder 'path))
    
48.                )
    
49.             )
    
50.   )
    
51.   (if (vl-catch-all-error-p catchit)
    
52.     nil
    
53.     path
    
54.   )
    
55. )
    
56. ;;;打开空白图形加载后使用
    
57. (defun c:tt()
    
58.   (setq path (getFolder "\n选择文件夹"))
    
59.   (if path
    
60.     (gxl-batchCommand path burstdim)
    
61.     )
    
62.    
    
63.   )
    

;;;批处理函数框架<br /> (defun batchCommand (path fun / files doc)<br />   (setq files (vl-directory-files path "*.dwg" 1))<br />   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (foreach dwgname files<br />    (setq dwgname (strcat path "\\" dwgname))<br />     (if (/= (strcase dwgname) (strcase (strcat (getvar "dwgprefix") dwgname)))<br />       (progn<br />     (if (= 8 (logand 8 (getvar 'UNDOCTL)))<br />       (vla-EndUndoMark doc)<br />     )<br />     (vla-StartUndoMark doc)<br />     (setvar "clayer" "0")<br />     (command "-layer" "u" "*" "t" "*" "")<br />     (command "insert" dwgname '(0 0 0) 1 1 0)<br />     (command "explode" (entlast))<br />     (command "-layer" "u" "*" "t" "*" "")<br />     ;;;处理动作<br />     (VL-CATCH-ALL-APPLY (FUNCTION fun))<br />     ;;;回写文件<br />     (command "wblock" dwgname "*")<br /> <br />     (if (= 8 (logand 8 (getvar 'UNDOCTL)))<br />       (vla-EndUndoMark doc)<br />     )<br />     (command  "_u")<br />     )<br />       )<br />     )<br />   )<br /> ;;;炸DIM<br /> (defun burstdim (/ qa ss)<br />   (setq qa (getvar "QAFLAGS"))<br />   (setvar "QAFLAGS" 1)<br />   (setq ss (ssget "x" '((0 . "*DIMENSION"))))<br />   (if ss (command "explode" ss ""))<br />   (setvar "QAFLAGS" qa)<br />   )<br /> ;;;取文件夹<br /> (defun getFolder (msg / WinShell shFolder path catchit)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))<br />   (setq<br />     catchit (vl-catch-all-apply<br />               '(lambda ()<br />                  (setq shFolder (vlax-get-property shFolder 'self))<br />                  (setq path (vlax-get-property shFolder 'path))<br />                )<br />             )<br />   )<br />   (if (vl-catch-all-error-p catchit)<br />     nil<br />     path<br />   )<br /> )<br /> ;;;打开空白图形加载后使用<br /> (defun c:tt()<br />   (setq path (getFolder "\n选择文件夹"))<br />   (if path<br />     (gxl-batchCommand path burstdim)<br />     )<br />     <br />   )<br />

yoyoho

感谢Gu_xl 分享程序,学习了!

asdfghjksz

非常感谢Gu_xl 的详细解答，只是运行后发现命令行提示; error: no function definition: GXL-BATCHCOMMAND，我新建空白图形加载也一样提示，请问是什么原因或我操作有误？

Andyhon

(gxl-batchCommand path burstdim)
试试======>
(batchCommand path burstdim)