masterlong 发表于 2018-6-28 20:45:42

嵌套块内部分解

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

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

masterlong 发表于 2020-6-10 17:48:03

本帖最后由 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最新版才能上传附件吗?
在我看来最新版自带的什么助手就是个流氓软件



magicheno 发表于 2020-6-10 23:11:39

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-28 20:46:00

本帖最后由 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))
)
)


masterlong 发表于 2018-6-28 20:46:29

程序升版预留

masterlong 发表于 2018-6-28 20:46:42

程序升版预留

taoyi0727 发表于 2018-6-28 23:17:41

ss2list试了下这个没有

masterlong 发表于 2018-6-28 23:42:37

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

panliang9 发表于 2018-6-29 08:49:10

好东西,非常感谢!

yanchao316 发表于 2018-6-29 09:57:17

很实用的工具,谢谢分享

忙出一个未来 发表于 2018-7-3 13:38:49

很实用的工具,谢谢分享

yoyoho 发表于 2018-7-3 15:22:25

谢谢!分享学习!!!!
页: [1] 2 3 4 5 6
查看完整版本: 嵌套块内部分解