怎么获取炸开后的所有对象
是这样的，我写了一个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)
)
使用上一次选择集，我很喜欢用(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 于 2018-9-1 20:43 编辑
ZZXXQQ 发表于 2015-10-19 16:38
感谢！！学到东西了 两个办法
方法1，用vla-explode
方法2，炸开之前先使用entlast，炸开之后再循环使用entnext 陨落 发表于 2015-10-19 11:16 static/image/common/back.gif
两个办法
方法1，用vla-explode
方法2，炸开之前先使用entlast，炸开之后再循环使用entnext
请问可以在原代码的基础上改写吗？新手不能一点就通，还需要大哥给出完整的代码，我再好好研究学习
(DEFUN C:TT ()
;(setq na (car (entsel)))
(setq ss(ssget))
(setq ii 0)
(repeat (sslength ss)
(setq name (ssname ss ii)
ii (1+ ii)
)
(setq s(EXPLODE name))
(sssetfirst nil s)
)
)
;;; 功能 选取炸开后的图形
(defunEXPLODE (name / aa entlastt sadd)
(setq entlastt (entlast))
(setq sadd (ssadd))
(command "_EXPLODE" name)
(setq aa (entnex entlastt sadd))
)
(defunentnex (entlast_ ssadd_ /)
(while (setq entlast_ (entnext entlast_))
(ssadd entlast_ ssadd_)
)
) 434939575 发表于 2015-10-19 11:52 static/image/common/back.gif
大哥，不行啊，如果只选择一个多段线是可以炸开并返回没问题，但是如果同时选择了“多段线”、“直线”和“块”就没办法炸开了，返回的还是“无效选择”。测试的图纸我放在附件里了，还有其他的办法吗？
(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))
(setvar "QAFLAGS" 1)
(command "explode" ss1 "")
(setvar "QAFLAGS" 0)
(setq ss2 (ssget "p"))
(if ss2 (progn
(command ".select" ss1 ss2 "")
(setq ss3 (ssget "p"))
)
(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)
)
ZZXXQQ 发表于 2015-10-19 16:38 static/image/common/back.gif
拜谢版主大大！ 我去，版主代码经简实用!!!!!!!!!!!!!!!!!
页:
[1]
2