怎么获取炸开后的所有对象

azbk00

是这样的，我写了一个lisp，目的是给定一个选择集，然后把选择集内所有的对象都炸开，再把炸开后的所有对象（包括选择集中不能被炸开的对象）统一换成洋红色，最后把它们统一放到我自建的LClayer图层中，并且创建为块。那个 ZG_MakeBlock子程序不用管，是我从论坛里收集来的一位大神的代码，目的就是快速建块用的。
代码不完善，有两个问题想请教下各位：
一、考虑到块中块的问题，有时候执行一次explode命令不够，要怎么对原有对象进行多次炸开直到不能炸开为止？
二、代码中我想用ss3来获取最终炸开后的所有对象（包括选择集中不能被炸开的对象），再给ss3换颜色和图层。但是在有些情况下ss3抓取的对象却不全。请问该怎么改写代码解决？
PS：测试的图纸已经放到附件了，还望各位大神帮小弟测试解决一下，感激不尽！

(defun c:bbb();改成洋红色块
(setvar "cmdecho" 0)
(command "undo" "be")
(if (null (tblsearch "LAYER" "LClayer"))
(entmake (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
         (cons 2 "LClayer")       ;图层名称
        '(70 . 0)                 ;图层状态
        '(62 . 6)                 ;图层颜色
        '(6 . "bylayer")          ;图层线型
            )
   )
)
  (setq ss1(ssget))
  (command "explode" ss1 "")
  (setq ss2 (ssget "p"))
  (if ss2
      (progn
           (command ".select" ss1 ss2 "")
           (setq ss3 (ssget "p"))
      )
      (progn
           (setq ss3 ss1)
      )
   )
  (command "change" ss3 "" "p" "c" "6" "")
  (command "change" ss3 "" "p" "la" "LClayer" "")
  (ZG_MakeBlock ss3)
  (command "undo" "e")
  (setvar "cmdecho" 1)
(princ)
)



(defun ZG_MakeBlock (ss3 / zg-GetSSBoundingbox blipmode_bak ss blkname ssbox basept inspt);快速创建块,块名为当前时间(如"2012101620161699"),块基点为选择集中心点   
    (defun zg-GetSSBoundingbox (ss / i ssn ll rr box ptlist ssbox)
        (if ss
            (progn
                (setq i -1)
                (repeat (sslength ss)
                    (setq ssn (ssname ss (setq i (1+ i))))
                    (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒
                    (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
                    (setq ptlist (append box ptlist))
                )
                (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))
            )
        )
    )
    (vl-load-com)
    (setq ss (cadr (ssgetfirst)))
    (setvar "cmdecho" 0)
    (princ "\n选择快速创建块的对象: ")
    (if (or ss (setq ss ss3))
        (progn
            (setq blkname (rtos (* (getvar "cdate") 1e8)))
            (setq ssbox (zg-GetSSBoundingbox ss))
            (setq basept (apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox)))
            (command "_.block" blkname "non" basept ss "");创建块并删除创建块的对象
            (setq inspt basept)
            (command "_.insert" blkname "x" 1 "y" 1 "z" 1 "r" 0 "non" inspt);插入块
        )
    )
    (setvar "cmdecho" 1)
    (princ)
)

qazxswk

使用上一次选择集，我很喜欢用(ssget "c" p1 p2)，在版主大大的代码上做了修改，供你参考。

(defun c:11();改成洋红色块
(setvar "cmdecho" 0)
(command "undo" "be")
(if (null (tblsearch "LAYER" "LClayer"))
(entmake (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
         (cons 2 "LClayer")       ;图层名称
        '(70 . 0)                 ;图层状态
        '(62 . 6)                 ;图层颜色
        '(6 . "bylayer")          ;图层线型
            )
   )
)
(setq p1 (getpoint "框选第一点"))
(setq p2 (getcorner p1 "\n框选对角点"))
(setvar "QAFLAGS" 1)
(command "explode" (ssget "c" p1 p2 ) "")
(setvar "QAFLAGS" 0)
(command "change" (ssget "c" p1 p2 ) "" "p" "c" "6" "")
(command "change" (ssget "c" p1 p2 ) "" "p" "la" "LClayer" "")
(ZG_MakeBlock (ssget "c" p1 p2 ))
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)

半夜星星

改了一下楼上大哥的，我看也能达到效果，解决问题
(defun c:CCC ()
        (setq ss(ssget))
        (setq i 0)       
        (setq SSNEW (ssadd));;设为空选择集
        (repeat (sslength ss)
                (setq name (ssname ss i))
    (setq i (1+ i))
                (setq entlastt (entlast));;记录当前的最后一个图元
                (command "_EXPLODE" name "");;炸开
                (while (setq entlastt (entnext entlastt))
                        (ssadd entlastt SSNEW)
                )       
        )       
        (PRINT (sslength SSNEW))
        (sssetfirst nil SSNEW);打开夹点句柄并选择 SSNEW 中的所有对象
)

xujinhua

ZZXXQQ 发表于 2015-10-19 16:38

感谢！！学到东西了

陨落

两个办法
方法1，用vla-explode
方法2，炸开之前先使用entlast，炸开之后再循环使用entnext

azbk00

陨落 发表于 2015-10-19 11:16
两个办法
方法1，用vla-explode
方法2，炸开之前先使用entlast，炸开之后再循环使用entnext

请问可以在原代码的基础上改写吗？新手不能一点就通，还需要大哥给出完整的代码，我再好好研究学习

434939575

2. 
   
3. (DEFUN C:TT ()
   
4.   ;(setq na (car (entsel)))
   
5. (setq ss(ssget))
   
6.   (setq ii 0)
   
7.   (repeat (sslength ss)
   
8.     (setq name (ssname ss ii)
   
9.           ii   (1+ ii)
   
10.     )
    
11.   (setq s(EXPLODE name))
    
12. (sssetfirst nil s)
    
13.   )
    
14.   )
    
15. 
    
16. ;;; 功能 选取炸开后的图形
    
17.   (defun  EXPLODE (name / aa entlastt sadd)
    
18.   (setq entlastt (entlast))
    
19.   (setq sadd (ssadd))
    
20.   (command "_EXPLODE" name)
    
21.   (setq aa (entnex entlastt sadd))
    
22.   
    
23. )
    
24. (defun  entnex (entlast_ ssadd_ /)
    
25.    (while (setq entlast_ (entnext entlast_))
    
26.     (ssadd entlast_ ssadd_)
    
27.   )
    
28. )

<br /> (DEFUN C:TT ()<br />   ;(setq na (car (entsel)))<br /> (setq ss(ssget))<br />   (setq ii 0)<br />   (repeat (sslength ss)<br />     (setq name (ssname ss ii)<br />           ii   (1+ ii)<br />     )<br />   (setq s(EXPLODE name))<br /> (sssetfirst nil s)<br />   )<br />   )<br /> <br /> ;;; 功能 选取炸开后的图形<br />   (defun  EXPLODE (name / aa entlastt sadd)<br />   (setq entlastt (entlast))<br />   (setq sadd (ssadd))<br />   (command "_EXPLODE" name)<br />   (setq aa (entnex entlastt sadd))<br />   <br /> )<br /> (defun  entnex (entlast_ ssadd_ /)<br />    (while (setq entlast_ (entnext entlast_))<br />     (ssadd entlast_ ssadd_)<br />   )<br /> )

azbk00

434939575 发表于 2015-10-19 11:52

大哥，不行啊，如果只选择一个多段线是可以炸开并返回没问题，但是如果同时选择了“多段线”、“直线”和“块”就没办法炸开了，返回的还是“无效选择”。测试的图纸我放在附件里了，还有其他的办法吗？

ZZXXQQ

2. (defun c:bbb();改成洋红色块
   
3. (setvar "cmdecho" 0)
   
4. (command "undo" "be")
   
5. (if (null (tblsearch "LAYER" "LClayer"))
   
6. (entmake (list
   
7.         '(0 . "LAYER")
   
8.         '(100 . "AcDbSymbolTableRecord")
   
9.         '(100 . "AcDbLayerTableRecord")
   
10.          (cons 2 "LClayer")       ;图层名称
    
11.         '(70 . 0)                 ;图层状态
    
12.         '(62 . 6)                 ;图层颜色
    
13.         '(6 . "bylayer")          ;图层线型
    
14.             )
    
15.    )
    
16. )
    
17.   (setq ss1(ssget))
    
18.   (setvar "QAFLAGS" 1)
    
19.   (command "explode" ss1 "")
    
20.   (setvar "QAFLAGS" 0)
    
21.   (setq ss2 (ssget "p"))
    
22.   (if ss2 (progn
    
23.    (command ".select" ss1 ss2 "")
    
24.    (setq ss3 (ssget "p"))
    
25.   )
    
26.    (setq ss3 ss1)
    
27.   )
    
28.   (command "change" ss3 "" "p" "c" "6" "")
    
29.   (command "change" ss3 "" "p" "la" "LClayer" "")
    
30.   (ZG_MakeBlock ss3)
    
31.   (command "undo" "e")
    
32.   (setvar "cmdecho" 1)
    
33.   (princ)
    
34. )
    

(defun c:bbb();改成洋红色块<br /> (setvar "cmdecho" 0)<br /> (command "undo" "be")<br /> (if (null (tblsearch "LAYER" "LClayer"))<br /> (entmake (list<br />         '(0 . "LAYER")<br />         '(100 . "AcDbSymbolTableRecord")<br />         '(100 . "AcDbLayerTableRecord")<br />          (cons 2 "LClayer")       ;图层名称<br />         '(70 . 0)                 ;图层状态<br />         '(62 . 6)                 ;图层颜色<br />         '(6 . "bylayer")          ;图层线型<br />             )<br />    )<br /> )<br />   (setq ss1(ssget))<br />   (setvar "QAFLAGS" 1)<br />   (command "explode" ss1 "")<br />   (setvar "QAFLAGS" 0)<br />   (setq ss2 (ssget "p"))<br />   (if ss2 (progn<br />    (command ".select" ss1 ss2 "")<br />    (setq ss3 (ssget "p"))<br />   )<br />    (setq ss3 ss1)<br />   )<br />   (command "change" ss3 "" "p" "c" "6" "")<br />   (command "change" ss3 "" "p" "la" "LClayer" "")<br />   (ZG_MakeBlock ss3)<br />   (command "undo" "e")<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )<br />

azbk00

ZZXXQQ 发表于 2015-10-19 16:38

拜谢版主大大！

894560869

我去，版主代码经简实用!!!!!!!!!!!!!!!!!