不用打开就能批量清理图形

soly2006

有人能告诉我不用打开就能批量清理图形的lisp吗？

用purge得一个个打开清理，上百个文件很累人啊

求大爷们替小民作主

-----sos-------

phoenixdjq

一下程序是从本论坛下载的，忘记是哪位高手编的了，我借花献佛了。

;程序执行：
;在命令行中输入userpurge或userwblock，选择文件夹，就可以了；
;userpurge对目标文件夹下的每个文件执行purge后保存文件；
;userwblock将目标文件夹下的每个文件执行wblock，写入目标文件夹下的"处理后的"子文件夹文件中，文件名不变；
(vl-load-com)

(defun getFolder (str_title str_prompt /)
    (strcat
        (vl-string-right-trim
            "\\"
            (strcase
                (acet-ui-pickdir str_prompt (vl-string-right-trim "\\" (getvar "dwgprefix")) str_title)
            )
        )
        "\\"
    )
)

(defun makeDirectory (dir / )
    (vl-mkdir dir)
)

(defun userundo()
    (setq *error* errtmp)
    (setvar "cmdecho" old_cmdecho)
    (setvar "acadlspasdoc" old_acadlspasdoc)
    (princ)
)

(defun err (msg)
  (userundo)
)

(defun c:userpurge ( / app doc docs err errtmp file files newpath old_acadlspasdoc old_cmdecho path sset)
  (setq errtmp *error*)
  (setq *error* err)
    (setq old_cmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (setq old_acadlspasdoc (getvar "acadlspasdoc"))
    (setvar "acadlspasdoc" 0)
  (setq path (getFolder "请选择目录..." "请选择目录："))
  (setq files (vl-directory-files path "*.dwg" 1))
  (if files
        (progn
                (setq scrfile (strcat path "batpurge.scr"))
                (setq fn (open scrfile "w"))
                (foreach file files
                    (setq str (strcat "open \" " path file "\" purge all * no qsave close"))
                    (write-line str fn)(princ)
                )
                (close fn)
        )
    (alert "所选目录无 .dwg 文件！请重新选择：")
  )
    (command "script" scrfile)
    (userundo)
  (setq *error* errtmp)
  (princ)
)

(defun c:userwblock ( / app doc docs err errtmp file files newpath old_acadlspasdoc old_cmdecho path sset)
  (setq errtmp *error*)
  (setq *error* err)
    (setq old_cmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (setq old_acadlspasdoc (getvar "acadlspasdoc"))
    (setvar "acadlspasdoc" 0)
  (setq path (getFolder "请选择目录..." "请选择目录："))
  (setq files (vl-directory-files path "*.dwg" 1))
  (if files
        (progn
          (setq newpath (strcat path "处理后的\\"))
                (setq scrfile (strcat newpath "batwblock.scr"))
                (makeDirectory newpath)
                (setq fn (open scrfile "w"))
                (foreach file files
                    (setq str (strcat "open \" " path file "\" wblock " newpath file " * qsave close"))
                    (write-line str fn)(princ)
                )
                (close fn)
        )
    (alert "所选目录无 .dwg 文件！请重新选择：")
  )
    (command "script" scrfile)
    (userundo)
  (setq *error* errtmp)
  (princ)
)

zml84

lisp写scr脚本，是非常经典的跨图档执行方法。

AutoCAD2012

script貌似作用有限, 还是不如lisp得心应手吧.

jxphklibin

2楼的方法还是一个个的打开，清理只有保存在关闭，没有理解1楼的意思：不打开图形而实现清理！！！

andyding

zml84 发表于 2010-2-3 21:18
lisp写scr脚本，是非常经典的跨图档执行方法。

大侠，你上图的这个软件可以给我一份吗？

langjs

这里边就有lisp写scr脚本批量清理垃圾的功能
http://bbs.mjtd.com/thread-92000-1-1.html