有没有图纸批量写块，新块名称为原来图名的程序？

半听可乐

今天找了一下午的图纸瘦身方法，发现都不太理想，反而是简单的wblock命令最有效！（能把图纸大小减为50%左右！）但是用这种方式有点麻烦：
1.需要一张一张开图
2.需要重命名（否则出现一大堆“新块”）

有没有这样的程序，运行之后选择文件或者文件夹，把里面的dwg图形批量打开--全图block--重命名为原来图纸名称另存一个文件夹（或者加前缀“压缩-”保存在原来文件夹）

很想发悬赏，但是就2个币了，拿不出手，希望大神以拯救苍生为己任，为了广大CAD画图人员造福

wowan1314

要善用论坛搜索功能。

这个估计刚好是楼主要找的。
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=52271

半听可乐

wowan1314 发表于 2012-8-14 16:40
要善用论坛搜索功能。

这个估计刚好是楼主要找的。

苍天有眼，我找了大半天~~~这个用用起来还是有问题： 错误: no function definition: ACET-UI-PICKDIR

半听可乐

半听可乐 发表于 2012-8-14 17:03
苍天有眼，我找了大半天~~~这个用用起来还是有问题： 错误: no function definition: ACET-UI-PICKDIR

你是指院长的xcad.VLX吗？我加载了，还是不行，提示依旧

【KAIXIN】

选对象 提取对象图元名 建块 基点用图元的中心

半听可乐

【KAIXIN】 发表于 2012-8-14 17:30
选对象 提取对象图元名 建块 基点用图元的中心

开心兄，你指的是？

ZZXXQQ

这个能用吧

1. (defun userundo()
   
2. (setq *error* errtmp)
   
3. (setvar "cmdecho" old_cmdecho)
   
4. (setvar "acadlspasdoc" old_acadlspasdoc)
   
5. (princ)
   
6. )
   
7. (defun err (msg) (userundo))
   
8. (defun c:userwblock ( / app doc docs err errtmp file files newpath old_acadlspasdoc old_cmdecho path sset)
   
9. (setq errtmp *error*)
   
10. (setq *error* err)
    
11. (setq old_cmdecho (getvar "cmdecho"))
    
12. (setvar "cmdecho" 0)
    
13. (setq old_acadlspasdoc (getvar "acadlspasdoc"))
    
14. (setvar "acadlspasdoc" 0)
    
15. (setq path (getFolder "请选择目录..." "请选择目录："))
    
16. (setq files (vl-directory-files path "*.dwg" 1))
    
17. (if files (progn
    
18.   (setq newpath (strcat path "处理后的\\"))
    
19.   (setq scrfile (strcat newpath "batwblock.scr"))
    
20.   (vl-mkdir newpath)
    
21.   (setq fn (open scrfile "w"))
    
22.   (foreach file files
    
23.    (setq str (strcat "open \"" path file "\" wblock " newpath file " * qsave close"))
    
24.    (write-line str fn)(princ)
    
25.   )
    
26.   (close fn)
    
27. )
    
28.   (alert "所选目录无 .dwg 文件！请重新选择：")
    
29. )
    
30. (command "script" scrfile)
    
31. (userundo)
    
32. (setq *error* errtmp)
    
33. (princ)
    
34. )
    

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

半听可乐

ZZXXQQ 发表于 2012-8-14 21:49
这个能用吧

朋友，我不会用啊，尝试了一下userwblock命令，提示no function definition: ACET-UI-PICKDIR

c735023723

我也下载下来试试看

eii

怎么我试用，提示缺少getFolder，少一个定义的函数吗