[灌水][原创]利用SCR和LSP实现目录下所有DWG文件批处理
本帖最后由 作者 于 2004-2-1 20:39:51 编辑利用SCR和LSP实现目录下所有DWG文件批处理
;;;==================================================================
;;;生成脚本文件
;;;11/09/0323:32:16创建
;;;12/10/034: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)
我也一直在用这种方法对某目录下的所有文件进行批量处理，，，，根据这几年的使用心得
有一个注意事项想跟大家共享交流一下
1. 执行完一个dwg文件，要转到open 第二个文件的时候，，比较麻烦的问题是 acad 总是询问如何存盘的问题。我采用的解决方法是让文件 saveas 为某个特定的临时文件（先查找是否存在，有则覆盖）
2. 以上问题，2004版本以上比较稳定好用，，acad2002则不稳定问题比较多，，至今没找到原因。 大俠把用處寫出來嘛. 不然大家不是很明白你的意思了. 要对同一目录下所有的图幅运行同一程序。
以前我的做法是写一个SCR，文件名用DOS命令DIR *.DWG/S/B >A.SCR 来获得，然后再修改它，插入(LOAD "程序")，再运行程序。
以上程序就是实现：
将选择文件所在目录下的所有DWG文件打开，并运行指定程序。 正是我所需 可以实现多文档相同的操作了。 能在程序里用command命令吗？ 好东西鲜花一朵
(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定义 多谢！送你鲜花！
页:
[1]
2