21
216
9
后起之秀
;;;================================================================== ;;;生成脚本文件 ;;;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) ;;检查 版本 (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 "当前路径下找不到文件.")) ) ) (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 "不能打开文件。")) ) ;;处理当前文件 (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在目录下的文件有:")) (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)) (.")) ;;是否要执行 (IF run_yn (PROGN (ALERT "\n\t确定后开始执行脚本...") (COMMAND "SCRIPT" filename_scr)) ) ) (ALERT (STRCAT "目录不存在。")) ) (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输入文件类型 :"))) (SETQ file_types "*.DWG") ) ;;SCR文件名 (IF (= "" (SETQ filename_scr (GETSTRING 1 (STRCAT "\n\t输入要生成的脚本文件名 :")))) (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当前文件是否存盘? :"))) (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t脚本运行过程中打开文件是否存盘? :"))) filename_lsp command_string (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t是否马上执行? :"))) ;马上执行 ) ) ;;;================================================================== (PRINC)
使用道具 举报
63
1203
10
顶梁支柱
25
5
初露锋芒
123
6
15
114
4
13
3
初来乍到
本版积分规则 发表回复 回帖后跳转到最后一页
微信公众平台
扫描访问手机版
点击图片下载手机App
|关于我们|小黑屋|乐筑天下 繁体中文
GMT+8, 2025-7-8 13:27 , Processed in 1.071861 second(s), 71 queries .
© 2020-2025 乐筑天下
在线时间:10:00-17:00
暂无
扫一扫,关注我们
帮助中心
关于我们
下载APP客户端