嵌套块清理（odcl）

masterlong

本来应该发在odcl板块的
但那里人比较少
还是发这里吧

命令：B0
程序功能：嵌套块清理
函数支持：opendcl

程序思路简要说明
将嵌套图块分为两类：顶层和非顶层
分两个列表显示
顶层类是可以直接删、炸开并清理的
非顶层不能直接删、炸、清理
对不需要清理的嵌套块加入忽略块名列表
顶层列表清空后自动刷新重置两列表
直到嵌套块全部清理完成


因为是从我的一个主程序中剥离出来的
程序中部分次要功能屏蔽
帮助界面的文字没改









opendcl运行支持库下载
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=173225&pid=778131&page=1&extra=#pid778131

10楼补了一个漏掉的函数

masterlong

这个程序后来做了些改进
加了【内部炸开】和【转换图层】两个功能
有空时整理下发上来

KEwb

可以发个支持CAD2020版本的么，感觉这个挺好用的

bing00

漏掉的函数  加在哪里没有说明清楚

yanchao316

感谢分享。。。。。。。

白色微風1991

感谢分享。。。。。。。masterlong你好為什麼不能用

masterlong

出错提示是啥？

fl202

遇到嵌套块是很烦的。好多人定义块时，对象没有在0层（习惯非常不好）。这样最后出图图纸上图层特别多，清理不掉。下面的程序：;---------- 将块内所有对象更改到0图层，颜色随层。
但遗憾的是不能处理嵌套块。

2. 
   
3. (defun c:0t1 ( / e i l n ss x )
   
4. ;---------- 将块内所有对象更改到0图层，颜色随层。
   
5.    (setvar "clayer" "0")
   
6.     (if (setq ss (ssget "X" '((0 . "INSERT"))))
   
7.         (repeat (setq i (sslength ss))
   
8.             (if (not (member (setq n (cdr (assoc 2 (entget (ssname ss (setq i (1- i))))))) l))
   
9.                 (progn
   
10.                     (setq e (tblobjname "block" n)
    
11.                           l (cons n l)
    
12.                     )
    
13.                     (while (setq e (entnext e))
    
14.                         (setq x (entget e))
    
15.                         (entmod (subst '(8 . "0") (assoc 8 x) x))
    
16.                     )
    
17.                 )
    
18.             )
    
19.         )
    
20.     )
    
21.     (command "_.regen")
    
22.     (princ)
    
23. )
    

<br /> (defun c:0t1 ( / e i l n ss x )<br /> ;---------- 将块内所有对象更改到0图层，颜色随层。<br />    (setvar "clayer" "0")<br />     (if (setq ss (ssget "X" '((0 . "INSERT"))))<br />         (repeat (setq i (sslength ss))<br />             (if (not (member (setq n (cdr (assoc 2 (entget (ssname ss (setq i (1- i))))))) l))<br />                 (progn<br />                     (setq e (tblobjname "block" n)<br />                           l (cons n l)<br />                     )<br />                     (while (setq e (entnext e))<br />                         (setq x (entget e))<br />                         (entmod (subst '(8 . "0") (assoc 8 x) x))<br />                     )<br />                 )<br />             )<br />         )<br />     )<br />     (command "_.regen")<br />     (princ)<br /> )<br />

hooboxu

fl202 发表于 2016-7-26 15:29
遇到嵌套块是很烦的。好多人定义块时，对象没有在0层（习惯非常不好）。这样最后出图图纸上图层特别多，清理 ...

挺好用.收藏.11

masterlong

嵌套块很多是ctrl+shift+v产生的
层层嵌套非常讨厌

白色微風1991

感谢分享。。。。。。。masterlong你好為什麼不能用
error: no function definition: DCL-FORM-SHOW

masterlong

标题和程序简介都说了
这是基于opendcl开发的
下个运行支持函数库

masterlong

貌似掉了个函数

;;检查块名，含wcmatch函数约定的特殊字符，在前加“`”以跳过特殊字符，保证块名过滤选择时图块能被选中
(defun checkblknm( nm / nmlist newlist )
        (if (wcmatch nm "*[`@`#`.`~]*,*`[*,*`]*")
                (progn
                        (setq nmlist (vl-string->list nm))
                        (setq newlist '())
                        (foreach x nmlist
                                (if (member x '(35 64 46 126 91 93))
                                        (setq newlist (cons x (cons 96 newlist)))
                                        (setq newlist (cons x newlist))
                                )
                        )
                        (vl-list->string (reverse newlist))
                )
                nm
        )
)