嵌套块内部分解
嵌套块指的是块中有块很多时候
特别是工艺提资图中的设备块
一层套一层
碰到这种情况我会用这个程序将其“内部分解”
也就是将一个原本的嵌套块
在块名不变的情况下内部块全部炸开
除了能减少dwg中的块定义外
这样做的意义在于
很多块的块心是随便定的
某些时候我需要重定义块心
但是如果这个块A被嵌套在其它块B的定义中
那么A的块心改位置后
块B就不正常了
对嵌套块执行“内部分解”后
就不用担心上面的情况了
本帖最后由 masterlong 于 2020-6-10 17:51 编辑
xxn基础上改了一下
代码比较乱
应该能用
命令 ： xxm
注意最后的说明文字
你先试试看
反馈下结果
没啥问题我再更新到首贴
(defun c:xxm() ;;(load "xxn```嵌套块内部分解.lsp") ;;(myloadlsp "xxn```嵌套块内部分解.lsp")
(princ "\n开始全图执行多层嵌套块改单层，可能需要一点时间")(princ)
(alert "n开始全图执行多层嵌套块改单层，可能需要一点时间")
;;(getkword)
(setvar "cmdecho" 0)
(command "undo" "g")
(xxm_main)
(command "undo" "e")
(princ "done")
(princ)
)
(defun xxm_main()
(vla-PurgeAll *doc*)
;;指定忽略块名列表（允许使用通配符）————允许通配符的情况下，本身带特殊字符的块名在核查的时候，应该会出现误判吧？？？
;;————是否应该分两个表：完全名称表和通配名称表？
;;完全名称表，需要进行特殊字符核查==============此表需使用者设定
(setq ignblk__list__1 '())
(setq ignblk__list__1 (mapcar '(lambda(x) (checkstr (strcase x))) ignblk__list__1))
;;通配名称表====================================此表需使用者设定
;;(setq ignblk__list__2 '())
(setq ignblk__list__2 '("QGY_*" "图名块*" "图名KL块*")) ;;个人设定
(setq ignblk__list__2 (mapcar 'strcase ignblk__list__2))
;;得到嵌套块相关8列表
(xxn_get_bob_list_and_str ignblk__list__1 ignblk__list__2)
;;顶层嵌套块改单层（必须是顶层，因为嵌套块也可能被嵌套，此时若先处理的是非顶层嵌套块的话，可能会引起其它问题）
(if bob_list_top
(progn
;;建立一个标记点
(command "point" "non" '(0 0))
(setq lastpoent (entlast))
(foreach x bob_list_top
(setq xblknm x);;块名
;;插入图块
(command "insert" xblknm "non" '(0 0) 1 1 0)
(command "_.explode" (entlast))
;;插入图块设为选择集
(setq ssss (ssget "p"))
;;循环方式将多层嵌套块分解至单层，得到分解后的选择集————————由于开始没有考虑这个功能，所以这里的代码比较“混乱”
(setq loop T evenexplodeNIL)
(while loop
;;(oldss2act ss)
(setq blkss (ssget "p" '((0 . "insert"))))
;;xxn原程序段需做调整，以适应xxm的功能需求。
(setq jixu 0)
(foreach yy (ss2list blkss) (setq y yy)(~~ (strcase (cdr (assoc 2 (entget y)))))
(setq currbn (strcase (cdr (assoc 2 (entget y)))))
;;保留非嵌套块和忽略列表不炸开，在这里添加判断
(if(or
(member currbn bob_list_low)
(member currbn ignblk__list__1)
(vl-some '(lambda(bnm) (wcmatch currbn bnm)) ignblk__list__2)
)
()
;;如果是嵌套块，执行下面的代码，同时将jixu+1 ，同时设 evenexplode = T
(progn
(setq jixu (1+ jixu)) ;;
(setq evenexplodeT) ;;如果曾经执行过炸开
(if (= 1 (cdr (assoc 66 (entget y))))
(progn
(burst-one y)
(command "_.explode" y)
;;同名块删除属性，如果屏蔽这一小节，同名属性块会保留属性————但是程序结束后，因块定义改变会导致图块多出一些文字
(setq haveattblkss (ssget "x" (list '(0 . "insert") (cons 2 xblknm))))
(foreach z (ss2list haveattblkss)
(while (setq
z (entnext z)
zlist (entget z)
ztype (cdr (assoc 0 zlist))
loop (= "ATTRIB" ztype)
)
(vla-erase (*ent2obj* z))
)
)
)
(command "_.explode" y)
)
)
)
)
(if (> jixu 0) (setq loop T) (setq loop NIL))
(setq ss (entbackss lastpoent))
)
(oldss2act ss)
(if (setq tempattss (ssget "p" '((0 . "ATTDEF"))))
(progn
(command "erase" tempattss "")
)
)
(setq ss (entbackss lastpoent))
;;做同名块（不插入）
(if evenexplode
(command "block" xblknm "y" "0,0" ss "")
(command "erase" ssss "")
)
)
;;删除标记点
(entdel lastpoent)
;;循环执行
;;;;;;(xxm_main) xxm不能用循环执行，否则无限循环了。某些代码需要相应修改下......
)
)
(princ)
)
代码复制到首贴的lsp文件里再加载
本来打算上传附件
但是
现在必须要安装flashplayer最新版才能上传附件吗？
在我看来最新版自带的什么助手就是个流氓软件
曰
defun c:exnest ( / doc ent )
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (/= "INSERT" (cdr (assoc 0 (entget ent))))
(princ "\nSelected object is not a block.")
)
)
)
)
(if ent
(progn
(vlax-for obj
(vla-item
(vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object))))
(LM:name->effectivename (cdr (assoc 2 (entget ent))))
)
(exnest:explode obj)
)
(vla-regen doc acallviewports)
)
)
(princ)
)
(defun exnest:explode ( obj / lst )
(if
(and
(= "AcDbBlockReference" (vla-get-objectname obj))
(vlax-write-enabled-p obj)
(not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
)
(progn
(foreach obj lst (exnest:explode obj))
(vla-deleteobj)
)
)
)
;; Block Name -> Effective Block Name-Lee Mac
;; blk - Block name
(defun LM:name->effectivename ( blk / rep )
(if
(and (wcmatch blk "`**")
(setq rep
(cdadr
(assoc -3
(entget
(cdr (assoc 330 (entget (tblobjname "block" blk))))
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(cdr (assoc 2 (entget rep)))
blk
)
)
(vl-load-com) (princ)
这个是晓东Lisphk的，可以实现框选嵌套块内部全部炸开的，不过也不支持保留底层块的 本帖最后由 masterlong 于 2018-6-29 08:58 编辑
本程序用于嵌套块内部分解。欢迎任意修改，仅修改作者名称除外
同学们若修改了程序，并且自认比较满意的，欢迎上传源码，大家共同学习，共同提高
需要说明的是，某些看似很简单的修改要求，实际可能需要对代码进行大量修改
由于本人工作比较忙，所以基本上不会对“程序修改请求”进行响应，请理解
本程序当前为全图执行，需要手动选择的请自行修改
另程序中有两个忽略块名列表，需要使用者自行设定，详见源码中注释
因为程序本身不是特别常用，程序中大量使用command
命令名：xxn
======================================================2018年06月28日by masterlong
;;嵌套块内部分解————不考虑多重插入块、无名块。
;|
1.首先找出顶层嵌套块
2.foreachx执行顶层嵌套块分解
a.原点比例1插入一图块
b.递归分解
c.分解后图元做同名块
3.重复1、2直到所有嵌套块分解完成
|;
;;程序结束后
;|
1.所有不带属性的原嵌套块，变为非嵌套块
2.所有带属性的原嵌套块，变为不含属性的非嵌套块，原块中属性按定义中默认值转化为文字。（注：dxf66仍为1）
|;
源码下载
若缺少子函数的说一下
-------------------------------------------------------------------------------------------补充缺少的子函数，附件中已补充
;;选择集转为图元列表
(defun ss2list ( ss / n i elist )
(setq n (if (= (type ss) 'Pickset) (sslength ss) 0)
i n
elist '()
)
(repeat n
(setq elist (cons (ssname ss (setq i (1- i))) elist))
)
)
程序升版预留 程序升版预留 ss2list试了下这个没有 手机上暂没法补代码 不过随便找一个同名子函数功能都是一样的 好东西，非常感谢！ 很实用的工具，谢谢分享 很实用的工具，谢谢分享 谢谢!分享学习!!!!