社区 › Auto Lisp › 分解嵌套块，然后分解

K Baden 发表于 2022-7-5 16:05:14

分解嵌套块，然后分解

大家早上好！
 
我真的很熟悉这段代码（我最近学到了很多！！）。我在某个地方找到了这个，我相信李不久前在一个论坛上发布了它。我已经编辑了它，以获取我想要的，它工作！！
但是，我也希望它能做得更多。分解我在代码中指定的图层上的嵌套块效果很好，但如果我还可以将图层、颜色和线型更改为“0”、ByBlock、ByBlock，我会喜欢它。这仅仅是在分解下添加另一行以放置颜色和放置层等的问题吗。？
 
还需要此选项来选择块中除文本/多行文字之外的所有内容。
 
我看到的一些代码建议我可能必须列出一个列表并引用，但这仍然有点超出我的理解范围。非常感谢您的帮助！！！
 
(defun c:TWRXP (/ s doc)
(if (setq s (ssget "X" '((0 . "INSERT") (8 . "TOWER"))))
   (progn
   (vlax-for obj (vla-item (vla-get-blocks
                               (setq doc (vla-get-activedocument
                                           (vlax-get-acad-object)
                                           )
                                     )
                               )
                           (vla-get-effectivename
                               (vlax-ename->vla-object (ssname s 0))
                               )
                           )
       (if (and
             (= "AcDbBlockReference" (vla-get-objectname obj))
             (null (vl-catch-all-error-p
                     (vl-catch-all-apply 'vla-explode (list obj))
                     )
                   )
             )
         (vl-catch-all-apply 'vla-delete (list obj))
         )
       )
   )
   )
(command "_.-purge" "_B" "*" "_N")
(vla-regen doc acallviewports)
(princ)
)(vl-load-com)

tombu 发表于 2022-7-5 17:07:17

从不建议分解任何方块，但请查看此处了解其余方块：http://www.cadtutor.net/forum/showthread.php?19161-lisp-for-changing-all-objects-in-a-block-to-layer-quot-0-quot
kbplc针对不同需求提供了多个版本。
 
还有一个版本：
; Written By: Tom Beauford
; Changes all block entities to layer "0" with color, linetype & lineweight ByBlock

(defun C:FIXBLKS (/ *ERROR* SSET intCount ENAM ELST BNAM FLST FIX1)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark thisdrawing)


(defun *ERROR* (err) ; define local handler
(vl-cmdf "undo" "Mark")
(princ "\n\n")
(princ)
);"" is the same message you get when exiting an AutoCAD command.

(defun FIX1 (BNAM / BENAM BONAM)
   (if (not (member BNAM FLST))
        (progn
          (setq FLST(cons BNAM FLST)
               BENAM (tblobjname "block" BNAM)
          )
(while (setq BENAM (entnext BENAM))
          (if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
      (fix1 (cdr (assoc 2 (entget BENAM))))
      (progn
      (setq BONAM(vlax-ename->vla-object BENAM))
                (vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
                (vl-catch-all-apply 'vla-put-color (list BONAM 0))
                (vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
                (vl-catch-all-apply 'vla-put-Lineweight (list BONAM -2))
                (Eq,$(Getvar,PStyleMode),0),STB,CTB )
                (eq(getvar "PStyleMode")0)(vl-catch-all-apply 'vla-put-PlotStyleName (list BONAM "Byblock")))
;                        (vl-catch-all-apply 'vla-put-PlotStyleName (list BONAM "Byblock"))
      )
    )
)
       )
   )
)

(setq SSET (ssget (list (cons 0 "INSERT"))))
(repeat (setq intCount (sslength SSET))
   (setq intCount   (1- intCount)
         ENAM (ssname SSET intCOunt)
          ELST (entget ENAM)
          BNAM (cdr (assoc 2 ELST))
          FLST nil
   )
   (fix1 BNAM)
)
(vl-cmdf "regen")
(vla-endundomark thisdrawing)
(princ)
)

查看完整版本: 分解嵌套块，然后分解