乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 122|回复: 8

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

[复制链接]

21

主题

216

帖子

9

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
305
发表于 2003-11-11 04:16:00 | 显示全部楼层 |阅读模式
利用SCR和LSP实现目录下所有DWG文件批处理
  1. ;;;==================================================================
  2. ;;;生成脚本文件
  3. ;;;11/09/03  23:32:16创建
  4. ;;;12/10/03  4:07 上午修改
  5. ;;;陈钊
  6. ;;;FILENAME_SCR  生成的SCR文件名
  7. ;;;DIR    要处理的目录,指向要操作的目录
  8. ;;;FILES_TYPE  文件类型,文件通配符,选定目录下的文件类型进行操作
  9. ;;;SAVE_AX_YN  当前是否要存盘,逻辑变量
  10. ;;;SAVE_YN  过种中是否要存盘,逻辑变量
  11. ;;;PROGRAM_FILE  要加载的程序,可以是空的
  12. ;;;COMMAND_LIST  要加裁的命令
  13. ;;;RUN_YN  是否马上执行
  14. ;;;调用    (MAKE_SCR "E:/TEMP" "*.DWG" "INSERT.SCR" T(SAVE_YN) "E:/BAK.LSP" (C:BBB) T(RUN_YN))
  15. (DEFUN make_scr (dir files_type filename_scr save_ax_yn save_yn program_file command_list run_yn / fp_scr)
  16.        ;;检查 版本
  17.        (IF (/= "15.05s (LMS Tech)" (GETVAR "ACADVER"))
  18.                (*error* "本程序要使用到AutoCAD Map 2000i的功能,请使用AutoCAD Map 2000i处理。")
  19.        )
  20.        (VL-LOAD-COM)
  21.        ;;判断目录是否存在
  22.        (IF (VL-FILE-DIRECTORY-P dir)
  23.                (PROGN ;;目录名,加载程序名,运行命令名中的\全部转为/
  24.                              (SETQ dir (VL-STRING-TRANSLATE "" "/" dir))
  25.                              (IF program_file
  26.                                      (IF (FINDFILE program_file)
  27.                                              (SETQ program_file (VL-STRING-TRANSLATE "" "/" (FINDFILE program_file)))
  28.                                              (*error* (STRCAT "当前路径下找不到文件."))
  29.                                      )
  30.                              )
  31.                              (SETQ command_list (VL-STRING-TRANSLATE "" "/" command_list))
  32.                              (SETQ filename_scr (VL-STRING-TRANSLATE "" "/" filename_scr))
  33.                              (IF (/= "/" (SUBSTR dir (STRLEN dir)))
  34.                                      (SETQ dir (STRCAT dir "/"))
  35.                              )                                                                   ;目录名最后必须以/结束
  36.                              ;;打开要生成的脚本文件
  37.                              (WHILE (NOT (SETQ fp_scr (OPEN filename_scr "W")))
  38.                                      (ALERT (STRCAT "不能打开文件。"))
  39.                              )
  40.                              ;;处理当前文件
  41.                              (IF save_ax_yn
  42.                                      (WRITE-LINE "(command "qsave")" fp_scr)
  43.                              )
  44.                              (IF (FINDFILE "d:/bak.dwg")
  45.                                      (WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg" "y")" fp_scr)
  46.                                      (WRITE-LINE "(command "saveas" "r14" "d:/bak.dwg")" fp_scr)
  47.                              )
  48.                              ;;检索选择目录下的文件
  49.                              (PRINC (STRCAT "\n\t在目录下的文件有:"))
  50.                              (PRINC "\n\t------------------------------")
  51.                              (FOREACH filename (VL-DIRECTORY-FILES dir files_type 1)
  52.                                      (PRINC (STRCAT "\n\t" filename))
  53.                                      (WRITE-LINE "(COMMAND "ZOOM" "E")" fp_scr)
  54.                                      (WRITE-LINE (STRCAT "(COMMAND "OPEN" ""
  55.                                                                              (IF save_yn
  56.                                                                                      "N"
  57.                                                                                      "Y"
  58.                                                                              )
  59.                                                                              "" ""
  60.                                                                              dir
  61.                                                                              filename
  62.                                                                              "")"
  63.                                                              )
  64.                                                              fp_scr
  65.                                      )
  66.                                      (IF (AND (= 'str (TYPE program_file)) (."))
  67.                              ;;是否要执行
  68.                              (IF run_yn
  69.                                      (PROGN (ALERT "\n\t确定后开始执行脚本...") (COMMAND "SCRIPT" filename_scr))
  70.                              )
  71.                )
  72.                (ALERT (STRCAT "目录不存在。"))
  73.        )
  74.        (PRINC)
  75. )
  76. ;;;==================================================================
  77. ;;;make_scr调用
  78. (DEFUN c:make_scr_file (/ command_string filename_lsp filename_scr file_types path shfolder)
  79.        (WHILE (NOT (SETQ shfolder (VLAX-INVOKE-METHOD (VLAX-CREATE-OBJECT "Shell.Application")
  80.                                                                                                      'browseforfolder
  81.                                                                                                      0
  82.                                                                                                      "选择要插入的目录:"
  83.                                                                                                      1
  84.                                                              )
  85.                                )
  86.                      )
  87.        )
  88.        (SETQ path (VLAX-GET-PROPERTY (VLAX-GET-PROPERTY shfolder 'self) 'path))
  89.        (IF (AND (/= "" (SUBSTR path (STRLEN path))) (/= "/" (SUBSTR path (STRLEN path))))
  90.                (SETQ path (STRCAT path "/"))
  91.        )
  92.        ;;文件类型
  93.        (IF (= "" (SETQ file_types (GETSTRING "\n\t输入文件类型 :")))
  94.                (SETQ file_types "*.DWG")
  95.        )
  96.        ;;SCR文件名
  97.        (IF (= "" (SETQ filename_scr (GETSTRING 1 (STRCAT "\n\t输入要生成的脚本文件名 :"))))
  98.                (SETQ filename_scr (STRCAT path "SCR.SCR"))
  99.        )
  100.        ;;LSP文件名
  101.        (SETQ filename_lsp (GETFILED "选择脚本要加载的程序:" (GETVAR "MENUNAME") "LSP" 0))
  102.        ;;执行的命令
  103.        (WHILE (= "" (SETQ command_string (GETSTRING 1 "\n\t输入要运行的命令行:"))))
  104.        ;;处理文件
  105.        (make_scr path
  106.                            file_types
  107.                            filename_scr
  108.                            (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t当前文件是否存盘? :")))
  109.                            (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t脚本运行过程中打开文件是否存盘? :")))
  110.                            filename_lsp
  111.                            command_string
  112.                            (PROGN (INITGET "Yes No") (= "Yes" (GETKWORD "\n\t是否马上执行? :"))) ;马上执行
  113.        )
  114. )
  115. ;;;==================================================================
  116. (PRINC)
回复

使用道具 举报

63

主题

1203

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1455
发表于 2003-11-11 16:07:00 | 显示全部楼层
大俠把用處寫出來嘛. 不然大家不是很明白你的意思了.
回复

使用道具 举报

21

主题

216

帖子

9

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
305
发表于 2003-11-16 21:54:00 | 显示全部楼层
要对同一目录下所有的图幅运行同一程序。
以前我的做法是写一个SCR,文件名用DOS命令DIR *.DWG/S/B >A.SCR 来获得,然后再修改它,插入(LOAD "程序"),再运行程序。
以上程序就是实现:
将选择文件所在目录下的所有DWG文件打开,并运行指定程序。
回复

使用道具 举报

10

主题

25

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2003-11-29 11:41:00 | 显示全部楼层
正是我所需
回复

使用道具 举报

wdb

25

主题

123

帖子

6

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
223
发表于 2003-11-29 15:16:00 | 显示全部楼层
可以实现多文档相同的操作了。
回复

使用道具 举报

wdb

25

主题

123

帖子

6

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
223
发表于 2003-12-1 08:41:00 | 显示全部楼层
能在程序里用command命令吗?
回复

使用道具 举报

15

主题

114

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2003-12-1 10:24:00 | 显示全部楼层
好东西鲜花一朵
回复

使用道具 举报

21

主题

216

帖子

9

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
305
发表于 2004-2-10 02:03:00 | 显示全部楼层
复制代码
回复

使用道具 举报

4

主题

13

帖子

3

银币

初来乍到

Rank: 1

铜币
29
发表于 2004-2-11 00:33:00 | 显示全部楼层
多谢!送你鲜花!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-8 13:27 , Processed in 1.071861 second(s), 71 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表