嵌套块内部分解

masterlong

嵌套块指的是块中有块
很多时候
特别是工艺提资图中的设备块
一层套一层
碰到这种情况我会用这个程序将其“内部分解”
也就是将一个原本的嵌套块
在块名不变的情况下内部块全部炸开

除了能减少dwg中的块定义外
这样做的意义在于
很多块的块心是随便定的
某些时候我需要重定义块心
但是如果这个块A被嵌套在其它块B的定义中
那么A的块心改位置后
块B就不正常了
对嵌套块执行“内部分解”后
就不用担心上面的情况了

masterlong

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   evenexplode  NIL)
    (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 evenexplode  T)   ;;如果曾经执行过炸开
               
               (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最新版才能上传附件吗？
在我看来最新版自带的什么助手就是个流氓软件
曰

magicheno

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-delete  obj)
       )
   )
)
;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] 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

本程序用于嵌套块内部分解。欢迎任意修改，仅修改作者名称除外
同学们若修改了程序，并且自认比较满意的，欢迎上传源码，大家共同学习，共同提高

需要说明的是，某些看似很简单的修改要求，实际可能需要对代码进行大量修改
由于本人工作比较忙，所以基本上不会对“程序修改请求”进行响应，请理解

本程序当前为全图执行，需要手动选择的请自行修改
另程序中有两个忽略块名列表，需要使用者自行设定，详见源码中注释

因为程序本身不是特别常用，程序中大量使用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))
)
)

masterlong

程序升版预留

masterlong

程序升版预留

taoyi0727

ss2list  试了下这个没有

masterlong

手机上暂没法补代码   不过  随便找一个同名子函数  功能都是一样的

panliang9

好东西，非常感谢！

yanchao316

很实用的工具，谢谢分享

忙出一个未来

很实用的工具，谢谢分享

yoyoho

谢谢!分享学习!!!!