[灌水][原创]利用SCR和LSP实现目录下所有DWG文件批处理

lockmyeye · 发表于 2003-11-11 04:16:00

本帖最后由作者于 2004-2-1 20:39:51 编辑

利用SCR和LSP实现目录下所有DWG文件批处理

;;;==================================================================
;;;生成脚本文件
;;;11/09/03 23:32:16创建
;;;12/10/03 4:07 上午修改
;;;陈钊
;;;FILENAME_SCR 生成的SCR文件名
;;;DIR 要处理的目录，指向要操作的目录
;;;FILES_TYPE 文件类型，文件通配符，选定目录下的文件类型进行操作
;;;SAVE_AX_YN 当前是否要存盘，逻辑变量
;;;SAVE_YN 过种中是否要存盘，逻辑变量
;;;PROGRAM_FILE 要加载的程序，可以是空的
;;;COMMAND_LIST 要加裁的命令
;;;RUN_YN 是否马上执行
;;;调用 (MAKE_SCR "E:/TEMP" "*.DWG" "INSERT.SCR" T(SAVE_YN) "E:/BAK.LSP" (C:BBB) T(RUN_YN))
(DEFUN make_scr (dir files_type filename_scr save_ax_yn save_yn program_file command_list run_yn / fp_scr)
;;检查AutoCAD 版本
(IF (/= "15.05s (LMS Tech)" (GETVAR "ACADVER"))
(*error* "本程序要使用到AutoCAD Map 2000i的功能，请使用AutoCAD Map 2000i处理。")
)
(VL-LOAD-COM)
;;判断目录是否存在
(IF (VL-FILE-DIRECTORY-P dir)
(PROGN ;;目录名，加载程序名，运行命令名中的\全部转为/
(SETQ dir (VL-STRING-TRANSLATE "\" "/" dir))
(IF program_file
(IF (FINDFILE program_file)
(SETQ program_file (VL-STRING-TRANSLATE "\" "/" (FINDFILE program_file)))
(*error* (STRCAT "当前路径下找不到文件<" program_file ">."))
)
)
(SETQ command_list (VL-STRING-TRANSLATE "\" "/" command_list))
(SETQ filename_scr (VL-STRING-TRANSLATE "\" "/" filename_scr))
(IF (/= "/" (SUBSTR dir (STRLEN dir)))
(SETQ dir (STRCAT dir "/"))
) ;目录名最后必须以/结束
;;打开要生成的脚本文件
(WHILE (NOT (SETQ fp_scr (OPEN filename_scr "W")))
(ALERT (STRCAT "不能打开文件<" filename_scr ">。"))
)
;;处理当前文件
(IF save_ax_yn
(WRITE-LINE "(command "qsave")" fp_scr)
)
(IF (FINDFILE "d:/bak.dwg")
(WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg" "y")" fp_scr)
(WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg")" fp_scr)
)
;;检索选择目录下的文件
(PRINC (STRCAT "\n\t在目录<" dir ">下的<" files_type ">文件有:"))
(PRINC "\n\t------------------------------")
(FOREACH filename (VL-DIRECTORY-FILES dir files_type 1)
(PRINC (STRCAT "\n\t" filename))
(WRITE-LINE "(COMMAND "ZOOM" "E")" fp_scr)
(WRITE-LINE (STRCAT "(COMMAND "OPEN" ""
(IF save_yn
"N"
"Y"
)
"" ""
dir
filename
"")"
)
fp_scr
)
(IF (AND (= 'str (TYPE program_file)) (< 0 (STRLEN program_file)))
(WRITE-LINE (STRCAT "(LOAD "" program_file "")") fp_scr)
)
(IF (AND (= 'str (TYPE command_list)) (< 0 (STRLEN command_list)))
(WRITE-LINE command_list fp_scr)
)
)
(PRINC "\n\t------------------------------")
(IF save_yn
(WRITE-LINE "QSAVE" fp_scr)
)
(CLOSE fp_scr)
(PRINC (STRCAT "\n\t已经输出脚本文件到\n\t<" filename_scr ">."))
;;是否要执行
(IF run_yn
(PROGN (ALERT "\n\t确定后开始执行脚本...") (COMMAND "SCRIPT" filename_scr))
)
)
(ALERT (STRCAT "目录<" dir ">不存在。"))
)
(PRINC)
)
;;;==================================================================
;;;make_scr调用
(DEFUN c:make_scr_file (/ command_string filename_lsp filename_scr file_types path shfolder)
(WHILE (NOT (SETQ shfolder (VLAX-INVOKE-METHOD (VLAX-CREATE-OBJECT "Shell.Application")
'browseforfolder
0
"选择要插入的目录:"
1
)
)
)
)
(SETQ path (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY shfolder 'self) 'path))
(IF (AND (/= "\" (SUBSTR path (STRLEN path))) (/= "/" (SUBSTR path (STRLEN path))))
(SETQ path (STRCAT path "/"))
)
;;文件类型
(IF (= "" (SETQ file_types (GETSTRING "\n\t输入文件类型 <*.DWG>:")))
(SETQ file_types "*.DWG")
)
;;SCR文件名
(IF (= "" (SETQ filename_scr (GETSTRING 1 (STRCAT "\n\t输入要生成的脚本文件名 <" path "SCR.SCR" ">:"))))
(SETQ filename_scr (STRCAT path "SCR.SCR"))
)
;;LSP文件名
(SETQ filename_lsp (GETFILED "选择脚本要加载的程序:" (GETVAR "MENUNAME") "LSP" 0))
;;执行的命令
(WHILE (= "" (SETQ command_string (GETSTRING 1 "\n\t输入要运行的命令行:"))))
;;处理文件
(make_scr path
file_types
filename_scr
(PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t当前文件是否存盘? <No>:")))
(PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t脚本运行过程中打开文件是否存盘? <No>:")))
filename_lsp
command_string
(PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t是否马上执行? <No>:"))) ;马上执行
)
)
;;;==================================================================
(PRINC)

;;;==================================================================
;;;生成脚本文件
;;;11/09/03  23:32:16创建
;;;12/10/03  4:07 上午修改
;;;陈钊
;;;FILENAME_SCR  生成的SCR文件名
;;;DIR    要处理的目录，指向要操作的目录
;;;FILES_TYPE  文件类型，文件通配符，选定目录下的文件类型进行操作
;;;SAVE_AX_YN  当前是否要存盘，逻辑变量
;;;SAVE_YN  过种中是否要存盘，逻辑变量
;;;PROGRAM_FILE  要加载的程序，可以是空的
;;;COMMAND_LIST  要加裁的命令
;;;RUN_YN  是否马上执行
;;;调用    (MAKE_SCR "E:/TEMP" "*.DWG" "INSERT.SCR" T(SAVE_YN) "E:/BAK.LSP" (C:BBB) T(RUN_YN))
(DEFUN make_scr (dir files_type filename_scr save_ax_yn save_yn program_file command_list run_yn / fp_scr)
       ;;检查<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a> 版本
       (IF (/= "15.05s (LMS Tech)" (GETVAR "ACADVER"))
               (*error* "本程序要使用到AutoCAD Map 2000i的功能，请使用AutoCAD Map 2000i处理。")
       )
       (VL-LOAD-COM)
       ;;判断目录是否存在
       (IF (VL-FILE-DIRECTORY-P dir)
               (PROGN ;;目录名，加载程序名，运行命令名中的\全部转为/
                             (SETQ dir (VL-STRING-TRANSLATE "\" "/" dir))
                             (IF program_file
                                     (IF (FINDFILE program_file)
                                             (SETQ program_file (VL-STRING-TRANSLATE "\" "/" (FINDFILE program_file)))
                                             (*error* (STRCAT "当前路径下找不到文件<" program_file ">."))
                                     )
                             )
                             (SETQ command_list (VL-STRING-TRANSLATE "\" "/" command_list))
                             (SETQ filename_scr (VL-STRING-TRANSLATE "\" "/" filename_scr))
                             (IF (/= "/" (SUBSTR dir (STRLEN dir)))
                                     (SETQ dir (STRCAT dir "/"))
                             )                                                                   ;目录名最后必须以/结束
                             ;;打开要生成的脚本文件
                             (WHILE (NOT (SETQ fp_scr (OPEN filename_scr "W")))
                                     (ALERT (STRCAT "不能打开文件<" filename_scr ">。"))
                             )
                             ;;处理当前文件
                             (IF save_ax_yn
                                     (WRITE-LINE "(command "qsave")" fp_scr)
                             )
                             (IF (FINDFILE "d:/bak.dwg")
                                     (WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg" "y")" fp_scr)
                                     (WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg")" fp_scr)
                             )
                             ;;检索选择目录下的文件
                             (PRINC (STRCAT "\n\t在目录<" dir ">下的<" files_type ">文件有:"))
                             (PRINC "\n\t------------------------------")
                             (FOREACH filename (VL-DIRECTORY-FILES dir files_type 1)
                                     (PRINC (STRCAT "\n\t" filename))
                                     (WRITE-LINE "(COMMAND "ZOOM" "E")" fp_scr)
                                     (WRITE-LINE (STRCAT "(COMMAND "OPEN" ""
                                                                             (IF save_yn
                                                                                     "N"
                                                                                     "Y"
                                                                             )
                                                                             "" ""
                                                                             dir
                                                                             filename
                                                                             "")"
                                                             )
                                                             fp_scr
                                     )
                                     (IF (AND (= 'str (TYPE program_file)) (< 0 (STRLEN program_file)))
                                             (WRITE-LINE (STRCAT "(LOAD "" program_file "")") fp_scr)
                                     )
                                     (IF (AND (= 'str (TYPE command_list)) (< 0 (STRLEN command_list)))
                                             (WRITE-LINE command_list fp_scr)
                                     )
                             )
                             (PRINC "\n\t------------------------------")
                             (IF save_yn
                                     (WRITE-LINE "QSAVE" fp_scr)
                             )
                             (CLOSE fp_scr)
                             (PRINC (STRCAT "\n\t已经输出脚本文件到\n\t<" filename_scr ">."))
                             ;;是否要执行
                             (IF run_yn
                                     (PROGN (ALERT "\n\t确定后开始执行脚本...") (COMMAND "SCRIPT" filename_scr))
                             )
               )
               (ALERT (STRCAT "目录<" dir ">不存在。"))
       )
       (PRINC)
)
;;;==================================================================
;;;make_scr调用
(DEFUN c:make_scr_file (/ command_string filename_lsp filename_scr file_types path shfolder)
       (WHILE (NOT (SETQ shfolder (VLAX-INVOKE-METHOD (VLAX-CREATE-OBJECT "Shell.Application")
                                                                                                     'browseforfolder
                                                                                                     0
                                                                                                     "选择要插入的目录:"
                                                                                                     1
                                                             )
                               )
                     )
       )
       (SETQ path (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY shfolder 'self) 'path))
       (IF (AND (/= "\" (SUBSTR path (STRLEN path))) (/= "/" (SUBSTR path (STRLEN path))))
               (SETQ path (STRCAT path "/"))
       )
       ;;文件类型
       (IF (= "" (SETQ file_types (GETSTRING "\n\t输入文件类型 <*.DWG>:")))
               (SETQ file_types "*.DWG")
       )
       ;;SCR文件名
       (IF (= "" (SETQ filename_scr (GETSTRING 1 (STRCAT "\n\t输入要生成的脚本文件名 <" path "SCR.SCR" ">:"))))
               (SETQ filename_scr (STRCAT path "SCR.SCR"))
       )
       ;;LSP文件名
       (SETQ filename_lsp (GETFILED "选择脚本要加载的程序:" (GETVAR "MENUNAME") "LSP" 0))
       ;;执行的命令
       (WHILE (= "" (SETQ command_string (GETSTRING 1 "\n\t输入要运行的命令行:"))))
       ;;处理文件
       (make_scr path
                           file_types
                           filename_scr
                           (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t当前文件是否存盘? <No>:")))
                           (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t脚本运行过程中打开文件是否存盘? <No>:")))
                           filename_lsp
                           command_string
                           (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t是否马上执行? <No>:"))) ;马上执行
       )
)
;;;==================================================================
(PRINC)

guisu771 · 发表于 2013-6-20 00:30:33

我也一直在用这种方法对某目录下的所有文件进行批量处理，，，，根据这几年的使用心得
有一个注意事项想跟大家共享交流一下

1. 执行完一个dwg文件，要转到 open 第二个文件的时候，，比较麻烦的问题是 acad 总是询问如何存盘的问题。我采用的解决方法是让文件 saveas 为某个特定的临时文件（先查找是否存在，有则覆盖）
2. 以上问题，2004版本以上比较稳定好用，，acad2002则不稳定问题比较多，，至今没找到原因。

BDYCAD · 发表于 2003-11-11 16:07:00

大俠把用處寫出來嘛. 不然大家不是很明白你的意思了.

lockmyeye · 发表于 2003-11-16 21:54:00

要对同一目录下所有的图幅运行同一程序。

以前我的做法是写一个SCR，文件名用DOS命令DIR *.DWG/S/B >A.SCR 来获得，然后再修改它，插入(LOAD "程序")，再运行程序。

以上程序就是实现：
将选择文件所在目录下的所有DWG文件打开，并运行指定程序。

zhang8755 · 发表于 2003-11-29 11:41:00

正是我所需

wdb · 发表于 2003-11-29 15:16:00

可以实现多文档相同的操作了。

wdb · 发表于 2003-12-1 08:41:00

能在程序里用command命令吗？

wb0815 · 发表于 2003-12-1 10:24:00

好东西鲜花一朵

lockmyeye · 发表于 2004-2-10 02:03:00

(IF (NULL findfiles_in_dir)
(LOAD "findfiles_in_dir")
)
;;;find_dir 搜索目录
;;;file_type 文件匹配符
;;;find_subdir 是否搜索子目录
;;;file_scr 脚本文件名
;;;commands 运行程序
;;;save_yn 是否保存文件
;;;run_yn 是否马上运行程序
;;;(make_scr_for_dir "E:/cz/2-03" "*.DWG" T "e:/scr.scr" "regen" nil nil)(DEFUN make_scr_for_dir (find_dir file_type find_subdir file_scr commands save_yn run_yn / files fp_scr)
;;判断目录是否存在
(IF (VL-FILE-DIRECTORY-P find_dir)
(IF (SETQ files (findfiles_in_dir find_dir file_type find_subdir))
(PROGN
;;打开要生成的脚本文件
(IF (NOT (SETQ fp_scr (OPEN file_scr "W")))
(*error* (STRCAT "不能打开文件<" file_scr ">。"))
)
;;生成脚本内容
(PRINC (STRCAT "\n在目录<" find_dir ">下的<" file_type ">文件有:"))
(PRINC "\n------------------------------")
(FOREACH filename files
(PRINC (STRCAT "\n" filename))
(WRITE-LINE "ZOOM\nE" fp_scr) ;全屏
(IF save_yn
(WRITE-LINE (STRCAT "OPEN\nN\n" filename) fp_scr)
(WRITE-LINE (STRCAT "OPEN\nY\n" filename) fp_scr)
) ;打开文件
(WRITE-LINE commands fp_scr) ;运行命令
)
(PRINC "\n------------------------------")
(IF save_yn
(WRITE-LINE "QSAVE" fp_scr)
)
(CLOSE fp_scr)
(PRINC (STRCAT "\n已经输出脚本文件到\n<" file_scr ">。"))
;;是否要执行
(IF run_yn
(PROGN (ALERT "\n确定后开始执行脚本...") (COMMAND "SCRIPT" file_scr))
)
)
(ALERT (STRCAT "目录<" find_dir ">不存在匹配<" file_type ">的文件。"))
)
(ALERT (STRCAT "目录<" find_dir ">不存在。"))
)
(PRINC)
)

复制代码

函数findfiles_in_dir定义

huxkv · 发表于 2004-2-11 00:33:00

多谢！送你鲜花！

陈亚娣 · 发表于 2013-6-19 16:37:45

账号		自动登录	找回密码
密码			注册