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