[求助]求一程序，自动打开文件夹下所有文件，并执行图形清理、缩放和保存命令(已解
本帖最后由 作者 于 2010-8-8 18:44:53 编辑 <br /><br /> [求助]求一程序，自动打开文件夹下所有文件，并执行图形清理、缩放和保存命令(已解决)<p>再详细说一下，比如文件夹下有很多文件，却在资源管理器中不显示缩略图，只显示图标。我的目的就是有一个程序在执行一次后，可以一个个打开这些文件，同时执行缩放——范围命令（为的是在资源管理器中显示的缩略图尽量大），完后保存退出。因为一个个手动打开在保存实在太费事了。<br/>谢谢！<br/>~~~~~~~~~~~~~~~~~~~~~~~~~~~<br/>非常感谢热心肠的gufeng，祝愉快！</p><p>~~~~~~~~~~~~~~~~~~~~~~~~~~~<br/></p> 确定在 选项-->打开和保存 此项 打勾
(defun c:Test(/ FILE_LIST FOLD SF SFF)
(vl-load-com)
;_Thanks caoyin
;_http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69986&replyID=&skin=0
(defun GetFileList (dirName / files lst)
(defun path-addBackSlash (path)
(if (not (member (substr path (strlen path)) '("\\" "/")))
(strcat path "\\")
path
)
)
(setq dirName (path-addBackSlash dirName)
files (mapcar '(lambda (x) (strcat dirName x))
(vl-directory-files dirName "*.dwg" 1)
)
)
(mapcar '(lambda (x)
(setq lst (append lst (GetFileList (strcat dirName x))))
)
(vl-remove-if
'(lambda (x) (member x '("." "..")))
(vl-directory-files dirName nil -1)
)
)
(append files lst)
)
;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
;; ========================================================
;; 作者：秋枫，参考了灯火的VBA程序
;; 用法：(qf_getFolder msg)
;; 例子：(qf_getFolder "选择文件夹:")
;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
;; http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=302
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(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
)
)
(setq fold (qf_getFolder "选择文件所在目录:"))
(if fold
(progn
(setq file_list (GetFileList fold))
(if file_list
(progn
(setq sf (strcat (getvar "TEMPPREFIX") "批处理文件20100806.scr"))
(setq sff (open sf "w"))
(mapcar '(lambda (x)
(princ (strcat "open \"" x "\"\n" "zoom e qsave close\n") sff)
)
file_list
)
(close sff)
(command "._script" sf)
(princ "\n处理完成")
)
(princ "\n目录下没有DWG文件")
)
)
(princ "\n请选择目录")
)
(princ)
)
mikewolf2k 发表于 2011-12-26 08:37 static/image/common/back.gif
for %1 in (c:\temp\*.dwg) do acad %1 /b"script"
没明白这个意思，能说说吗 Q晋胡 发表于 2020-8-6 16:32
大佬，能详细给我讲解一下吗？纯小白
这个方法已经不适用高版本的ACAD了。这个方法每个文件都会打开ACAD，执行，关闭。对于低版本的ACAD，打开ACAD的速度快，还可以接受。但对于高版本的ACAD，开一个ACAD要好长时间，无法接受了。
至于批处理，大量的代码可以在ACAD进程内实现批量打开处理，比这个方法好得多。 <p>谢谢提供！</p>
<p>试了试，没有弄成。怎么看起来有两部分？在27处。</p>
<p>麻烦你再解释一下。</p> 什么有两部分？一个命令 ，两个函数 。
执行命令Test ，处理文件列表写入一个临时的批处理文件 [批处理文件20100806.scr] 。
函数 (GetFileList dirName) 是获取指定目录下的所有DWG文件列表。
(qf_getFolder msg) 是选择目录，提供路径 由(GetFileList dirName) 获取文件列表。
增加一个是否立刻即行的选择
(defun c:Test(/ FILE_LIST FOLD SF SFF RunNow)
(vl-load-com)
;_Thanks caoyin
;_http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69986&replyID=&skin=0
(defun GetFileList (dirName / files lst)
(defun path-addBackSlash (path)
(if (not (member (substr path (strlen path)) '("\\" "/")))
(strcat path "\\")
path
)
)
(setq dirName (path-addBackSlash dirName)
files (mapcar '(lambda (x) (strcat dirName x))
(vl-directory-files dirName "*.dwg" 1)
)
)
(mapcar '(lambda (x)
(setq lst (append lst (GetFileList (strcat dirName x))))
)
(vl-remove-if
'(lambda (x) (member x '("." "..")))
(vl-directory-files dirName nil -1)
)
)
(append files lst)
)
;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
;; ========================================================
;; 作者：秋枫，参考了灯火的VBA程序
;; 用法：(qf_getFolder msg)
;; 例子：(qf_getFolder "选择文件夹:")
;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
;; http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=302
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(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
)
)
(setq fold (qf_getFolder "选择文件所在目录:"))
(if fold
(progn
(setq file_list (GetFileList fold))
(if file_list
(progn
(setq sf (strcat (getvar "TEMPPREFIX") "批处理文件20100806.scr"))
(setq sff (open sf "w"))
(mapcar '(lambda (x)
(princ (strcat "open \"" x "\"\n" "zoom e qsave close\n") sff)
)
file_list
)
(close sff)
(princ (strcat "\n目录下" fold "\n\t共有DWG文件数: " (itoa (length file_list))))
(initget "Y N")
(setq RunNow (getkword "\n是否立刻执行[是(Y)/否(N)]:<否>"))
(if (= RunNow "Y")
(progn
(command "._script" sf)
(princ "\n处理完成")
)
(princ "\n放弃立刻执行")
)
)
(princ "\n目录下没有DWG文件")
)
)
(princ "\n请选择目录")
)
(princ)
)
<p>好了，成了，谢谢！</p>
<p>再问一下，你这句“增加一个是否立刻即行的选择”是指第二次贴出的代码？</p>
<p>我不懂编程，所以请多包涵。</p> 是你重新复制使用4楼的代码 好的。我重试了一下，没感觉到这个“增加一个是否立刻即行的选择”表现在哪里？怎么跟第一次一样啊。 <p>搞明白了，重新加载后显示“是否立刻执行”的动作，不过我觉得有点没必要，最终还是选用了第一次的程序。</p>
<p>另外，下面这几行好像没起作用。</p>
<li>(princ "\n目录下没有DWG文件")
<li>)
<li>)
<li>(princ "\n请选择目录")</li> 能否再增加一个自动执行清理的功能？ <p>需要清理什么?像CAD的PURGE命令 全部清理没用的?</p>
<p>是否立刻执行 根据你的需要而定,比如你生成批处理文件后发现选择的目录下有几千个文件要处理,处理时候肯定会长点,比如中午外出吃饭再来处理^_^</p>
<p>而你需要先处理其它目录下的比较少文件的,就可以先取消.</p>
<p>以下两个是选择的目录下没有DWG文件提示与选择目录的窗口点了取消了才会提示. </p>
<li>(princ "\n目录下没有DWG文件") </li>
<li>) </li>
<li>) </li>
<li>(princ "\n请选择目录") </li>