求助大家,请问有没有能打散块中块的LSP程序

raimo

向大家求助,请问有没有能保持块不变的情况下打散块中块的LSP程序? 一直没发现..

因为经常需要如此操作,将一个块打散改成单一色,但是这个块是个复杂的图形,带有很多对象,其中就可能有2,3级的块内容..,每次都要先炸几次,然后再选择改色..
文件太多,反复选择几次挺麻烦.改一次之后还容易发现还有块没炸开...

就是这样一个情况,我需要后完成的所有对象组成一个块..

不知道这种能实现不? 谢谢

Gu_xl

一个简单的嵌套块一炸到底程序，对多重块不起作用:

1. (defun c:tt (/ olderr *error* blk ss ss1)
   
2.   (setq olderr *error*)
   
3.   (defun *error* (msg)
   
4.     (setvar "qaflags" 0)
   
5.     (princ msg)
   
6.     (princ)
   
7.   )
   
8.   (setvar "qaflags" 1)
   
9.   (if (and
   
10.         (setq blk (car (entsel "\n选择图块:")))
    
11.         (= "INSERT" (cdr (assoc 0 (entget blk))))
    
12.       )
    
13.     (progn
    
14.       (setq ss         (ssadd blk)
    
15.             cnt         (sslength ss)
    
16.             Flag t
    
17.       )
    
18.       (while (and Flag
    
19.                   (/= cnt
    
20.                       (sslength
    
21.                         (progn
    
22.                           (command "_explode" ss "")
    
23.                           (setq ss1 (ssget "_P"))
    
24.                           (if ss1
    
25.                             (setq ss ss1)
    
26.                             ss
    
27.                           )
    
28.                         )
    
29.                       )
    
30.                   )
    
31.              )
    
32.         (repeat        (setq n (sslength ss))
    
33.           (setq en (ssname ss (setq n (1- n))))
    
34.           (if (/= "INSERT" (cdr (assoc 0 (entget en))))
    
35.             (ssdel en ss)
    
36.           )
    
37.         )
    
38.         (setq cnt (sslength ss))
    
39.         (if (= 0 cnt)
    
40.           (setq Flag nil)
    
41.         )
    
42.       )
    
43.     )
    
44.   )
    
45.   (setvar "qaflags" 0)
    
46.   (setq *error* olderr)
    
47.   (princ)
    
48. )
    

(defun c:tt (/ olderr *error* blk ss ss1)<br />   (setq olderr *error*)<br />   (defun *error* (msg)<br />     (setvar "qaflags" 0)<br />     (princ msg)<br />     (princ)<br />   )<br />   (setvar "qaflags" 1)<br />   (if (and<br />         (setq blk (car (entsel "\n选择图块:")))<br />         (= "INSERT" (cdr (assoc 0 (entget blk))))<br />       )<br />     (progn<br />       (setq ss         (ssadd blk)<br />             cnt         (sslength ss)<br />             Flag t<br />       )<br />       (while (and Flag<br />                   (/= cnt<br />                       (sslength<br />                         (progn<br />                           (command "_explode" ss "")<br />                           (setq ss1 (ssget "_P"))<br />                           (if ss1<br />                             (setq ss ss1)<br />                             ss<br />                           )<br />                         )<br />                       )<br />                   )<br />              )<br />         (repeat        (setq n (sslength ss))<br />           (setq en (ssname ss (setq n (1- n))))<br />           (if (/= "INSERT" (cdr (assoc 0 (entget en))))<br />             (ssdel en ss)<br />           )<br />         )<br />         (setq cnt (sslength ss))<br />         (if (= 0 cnt)<br />           (setq Flag nil)<br />         )<br />       )<br />     )<br />   )<br />   (setvar "qaflags" 0)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br />

raimo

Gu_xl 发表于 2011-10-22 21:04
一个简单的嵌套块一炸到底程序，对多重块不起作用:

虽然这个不能保留最外面的一层为图块..但也挺方便用的了..也就多自己再手动组块一次..

非常感谢 Gu_xl 版主的出手相助!!!

yoyoho

感谢 Gu_xl  版主分享程序!

lijiao

不可能实现楼主想法，因为你想explode的是块的引用，不是改变块的定义。
正确的做法是层层explode块的引用，然后用explode后的图元生成一新的块。

raimo

lijiao 发表于 2011-10-24 09:04
不可能实现楼主想法，因为你想explode的是块的引用，不是改变块的定义。
正确的做法是层层explode块的引用 ...

我也明白, 大概难度就是炸完之后不好选择最后生成的对象重新组块..所以现在这样可以一炸到底也不错了..

vormittag

to 5楼，感觉楼主的需求也不是不能做到的。
现有一个思路，但是代码还没写，先把思路列出来，大家一起探讨。

函数实现功能是把修改块定义，把所有嵌套块分解并修改嵌套块的定义，步骤如下：
1、通过(tblobjname "block" blockname) 获得blockname块定义的图元名blockename
2、(entget blockename)得到blockename的图元列表，返回值中 -2 组码即是构成blockname图块的第一个图元名ename
3、获取ename的类型，如果不是图块，用entnext找下一个图元，直至图元类型是“ENDBLK”为止；如果是图块，取得图块定义名，打散图块，递归调用本函数。
4、用 entmod 更新图块定义。

Gu_xl

raimo 发表于 2011-10-24 10:27
我也明白, 大概难度就是炸完之后不好选择最后生成的对象重新组块..所以现在这样可以一炸到底也不错了..

把炸完的物体再收集起来，重定义块就是了！考虑到插入的块的比例可能不是1，所以在‘(0 0 0)处插入该块，比例为1，炸完后直接搜集炸完后的物体，重定义块即可！

1. (defun c:tt (/ olderr *error* blk ss ss1 os )
   
2.   (setq olderr *error*)
   
3.   (defun *error* (msg)
   
4.     (setvar "qaflags" 0)
   
5.     (setvar "osmode" os)
   
6.     (setvar "expert" expert)
   
7.     (princ msg)
   
8.     (princ)
   
9.   )
   
10.   (setvar "qaflags" 1)
    
11.   (setq os (getvar "osmode"))
    
12.   (setvar "osmode" 0)
    
13.   (setq expert (getvar "expert"))
    
14.   (setvar "expert" 5)
    
15.   (if (and
    
16.         (setq blk (car (entsel "\n选择图块:")))
    
17.         (= "INSERT" (cdr (assoc 0 (entget blk))))
    
18.       )
    
19.     (progn
    
20.       (setq name (cdr (assoc 2 (entget blk))))
    
21.       (command "insert" name '(0 0 0) 1 1 0)
    
22.       (setq blk (entlast))
    
23.       (setq ss         (ssadd blk)
    
24.             cnt         (sslength ss)
    
25.             Flag t
    
26.       )
    
27.       (while (and Flag
    
28.                   (/= cnt
    
29.                       (sslength
    
30.                         (progn
    
31.                           (command "_explode" ss "")
    
32.                           (setq ss1 (ssget "_P"))
    
33.                           (if ss1
    
34.                             (setq ss ss1)
    
35.                             ss
    
36.                           )
    
37.                         )
    
38.                       )
    
39.                   )
    
40.              )
    
41.         (repeat        (setq n (sslength ss))
    
42.           (setq en (ssname ss (setq n (1- n))))
    
43.           (if (/= "INSERT" (cdr (assoc 0 (entget en))))
    
44.             (ssdel en ss)
    
45.           )
    
46.         )
    
47.         (setq cnt (sslength ss))
    
48.         (if (= 0 cnt)
    
49.           (setq Flag nil)
    
50.         )
    
51.       )
    
52.       (setq ss (GXL-SEL-ENTNEXTALL blk))
    
53.       (command "block" name '(0 0 0) ss "")
    
54.     )
    
55.   )
    
56.   (setvar "osmode" os)
    
57.   (setvar "qaflags" 0)
    
58.   (setq *error* olderr)
    
59.   (princ)
    
60. )
    
61. (defun gxl-Sel-EntNextAll (ent / ss)
    
62.   (if (not ent)
    
63.     (progn
    
64.       (setq ent (entnext))
    
65.     (if ent
    
66.       (setq ss (ssadd ent))
    
67.       (setq ss (ssadd))
    
68.       )
    
69.   )
    
70.     (setq ss (ssadd))
    
71.     )
    
72.   (while (setq ent (entnext ent))
    
73.     (if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND")))
    
74.       (ssadd ent ss)
    
75.       )
    
76.     )
    
77.   (if (= 0 (sslength ss))
    
78.     nil
    
79.     ss
    
80.     )
    
81.   )
    

(defun c:tt (/ olderr *error* blk ss ss1 os )<br />   (setq olderr *error*)<br />   (defun *error* (msg)<br />     (setvar "qaflags" 0)<br />     (setvar "osmode" os)<br />     (setvar "expert" expert)<br />     (princ msg)<br />     (princ)<br />   )<br />   (setvar "qaflags" 1)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq expert (getvar "expert"))<br />   (setvar "expert" 5)<br />   (if (and<br />         (setq blk (car (entsel "\n选择图块:")))<br />         (= "INSERT" (cdr (assoc 0 (entget blk))))<br />       )<br />     (progn<br />       (setq name (cdr (assoc 2 (entget blk))))<br />       (command "insert" name '(0 0 0) 1 1 0)<br />       (setq blk (entlast))<br />       (setq ss         (ssadd blk)<br />             cnt         (sslength ss)<br />             Flag t<br />       )<br />       (while (and Flag<br />                   (/= cnt<br />                       (sslength<br />                         (progn<br />                           (command "_explode" ss "")<br />                           (setq ss1 (ssget "_P"))<br />                           (if ss1<br />                             (setq ss ss1)<br />                             ss<br />                           )<br />                         )<br />                       )<br />                   )<br />              )<br />         (repeat        (setq n (sslength ss))<br />           (setq en (ssname ss (setq n (1- n))))<br />           (if (/= "INSERT" (cdr (assoc 0 (entget en))))<br />             (ssdel en ss)<br />           )<br />         )<br />         (setq cnt (sslength ss))<br />         (if (= 0 cnt)<br />           (setq Flag nil)<br />         )<br />       )<br />       (setq ss (GXL-SEL-ENTNEXTALL blk))<br />       (command "block" name '(0 0 0) ss "")<br />     )<br />   )<br />   (setvar "osmode" os)<br />   (setvar "qaflags" 0)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br /> (defun gxl-Sel-EntNextAll (ent / ss)<br />   (if (not ent)<br />     (progn<br />       (setq ent (entnext))<br />     (if ent<br />       (setq ss (ssadd ent))<br />       (setq ss (ssadd))<br />       )<br />   )<br />     (setq ss (ssadd))<br />     )<br />   (while (setq ent (entnext ent))<br />     (if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND")))<br />       (ssadd ent ss)<br />       )<br />     )<br />   (if (= 0 (sslength ss))<br />     nil<br />     ss<br />     )<br />   )<br />

lijiao

方法如下：
1、用图元的explode方法循环炸开图块引用，注意，不是用command函数。
2、将新生成的图元定义为块。
3、插入刚定义的图块。
4、删除原有图块引用。

raimo

Gu_xl 发表于 2011-10-24 13:20
把炸完的物体再收集起来，重定义块就是了！考虑到插入的块的比例可能不是1，所以在‘(0 0 0)处插入该块 ...

没想到,我的想法还是有可能实现的,感谢Gu_xl 以及关注此贴的朋友,
也感谢明经这么好的论坛,让我们可以站在高手们的身边,
有你们的帮助才得以实现工作中那一些以前不敢想象的可以提高效率的愿望...


借Gu_xl版的帖子和以前在论坛学到的一点皮毛,加上了这句  (command "change" ss "" "p" "c" "250" "")
彻底实现了一键炸完块中块,改单一色并保留最外一层块的愿望..使用非常方便,再次感谢!!!