Lisp to Select Blocks and Explode

January 17

Hi,

I am looking for some help with regards to a lisp routine.

I have a scenario where I need to select multiple blocks (all named 'Service Connection') and then explode them. I currently do this using Qselect and then manually explode but wonder there is a way to do all of this in one lisp routine to speed up the process?

Thank you!

January 17

Try this

(defun c:myExplode (/ conj n ent lstent nmBlq para)
  (while (not para)
    (if (setq ent (car (entsel "\nSelect a sample of blocks to explode...")))
      (if (= (cdr (assoc 0 (setq lstent (entget ent)))) "INSERT")
	(setq nmBlq (cdr (assoc 2 lstent))
	      para    T
	)
	(princ
	  "\n*** SELECTED OBJECT IS NOT A BLOCK ***\Please, try again..."
	)
      )
      (princ
	"\n*** NOTHING SELECTED ***\Please, try again..."
      )
    )
  )
  (setq n 0)
  (if nmBlq
    (if (setq conj (ssget "x" (list (cons 0 "INSERT") (cons 2 nmBlq))))
      (WHILE (SETQ ent (SSNAME conj n))
	(setq lstent (entget ent)
	      n	     (+ n 1)
	)
	(vla-explode (vlax-ename->vla-object ent))
      )
    )
  )
  (princ)
)

January 17

13 minutes ago, GLAVCVS said:

Try this

(defun c:myExplode (/ conj n ent lstent nmBlq para)
  (while (not para)
    (if (setq ent (car (entsel "\nSelect a sample of blocks to explode...")))
      (if (= (cdr (assoc 0 (setq lstent (entget ent)))) "INSERT")
	(setq nmBlq (cdr (assoc 2 lstent))
	      para    T
	)
	(princ
	  "\n*** SELECTED OBJECT IS NOT A BLOCK ***\Please, try again..."
	)
      )
      (princ
	"\n*** NOTHING SELECTED ***\Please, try again..."
      )
    )
  )
  (setq n 0)
  (if nmBlq
    (if (setq conj (ssget "x" (list (cons 0 "INSERT") (cons 2 nmBlq))))
      (WHILE (SETQ ent (SSNAME conj n))
	(setq lstent (entget ent)
	      n	     (+ n 1)
	)
	(vla-explode (vlax-ename->vla-object ent))
      )
    )
  )
  (princ)
)

That is perfect, thank you so much!

January 17

I have been testing this and it works great for a standard block but I also have a scenario where I have some dynamic blocks and it doesn't seem to work for those. Is there a way to include dynamic blocks as well?

January 17

(defun c:myExplode (/ conj n ent lstent nmBlq para)
  (while (not para)
    (if (setq ent (car (entsel "\nSelect a sample of blocks to explode...")))
      (if (= (cdr (assoc 0 (setq lstent (entget ent)))) "INSERT")
	(setq v (vlax-ename->vla-object ent)
       ;; nmBlq (cdr (assoc 2 lstent))
	      nmBlq (vla-get-effectivename v)
	      para    T
	)
	(princ
	  "\n*** SELECTED OBJECT IS NOT A BLOCK ***\Please, try again..."
	)
      )
      (princ
	"\n*** NOTHING SELECTED ***\Please, try again..."
      )
    )
  )(print (strcat nmBlq ",`*U*"))
  (setq n 0)
  (if nmBlq
    (if (setq conj (ssget "x" (list (cons 0 "INSERT") (cons 2 (strcat nmBlq ",`*U*")))))
      (WHILE (SETQ ent (SSNAME conj n))
	(setq v (vlax-ename->vla-object ent)
	      lstent (entget ent)
	      n	     (+ n 1)
	)
	(if (eq (vla-get-effectivename v) nmBlq)
	(vla-explode v)
	  )
      )
    )
  )
  (princ)
)

Hi Andy, check the above code, few edits from GLAV's original code.

January 17

Note that (vla-explode) creates an exploded copy, the original reference will still exist.

January 18

Thanks for the feedback.
That's right: this code is only useful for standard blocks.
If you need to explode dynamic blocks as well, you can use the small variant of 'Burst.lsp' that I included below:

(Defun c:myBURST (/	   nmBlq    item     bitset   bump     att-text
		  lastent  burst-one	     burst    BCNT     BLAYER
		  BCOLOR   ELAST    BLTYPE   ETYPE    PSFLAG   ENAME
		  para	   ent	    lstent
		 )

					;-----------------------------------------------------
					; Item from association list
					;-----------------------------------------------------
  (Defun ITEM (N E) (CDR (Assoc N E)))
					;-----------------------------------------------------
					; Error Handler
					;-----------------------------------------------------

  (acet-error-init
    (list
      (list "cmdecho"
	    0
	    "highlight"
	    1
      )
      T					;flag. True means use undo for error clean up.
    )					;list
  )					;acet-error-init


					;-----------------------------------------------------
					; BIT SET
					;-----------------------------------------------------

  (Defun BITSET (A B) (= (Boole 1 A B) B))

					;-----------------------------------------------------
					; BUMP
					;-----------------------------------------------------

  (Setq bcnt 0)
  (Defun bump (prmpt)
    (Princ
      (Nth bcnt '("\r-" "\r\\" "\r|" "\r/"))
    )
    (Setq bcnt (Rem (1+ bcnt) 4))
  )

					;-----------------------------------------------------
					; Convert Attribute Entity to Text Entity or MText Entity
					;-----------------------------------------------------

  (Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
    (setq ANAME (cdr (assoc -1 AENT)))
    (if	(_MATTS_UTIL ANAME)
      (progn
					; Multiple Line Text Attributes (MATTS) -
					; make an MTEXT entity from the MATTS data
	(_MATTS_UTIL ANAME 1)
      )
      (progn
					; else -Single line attribute conversion
	(Setq TENT '((0 . "TEXT")))
	(ForEach INUM '(8 6 38 39 62 67	210 10 40 1 50 41 51 7 71 72 73
			11 74)
	  (If (Setq ILIST (Assoc INUM AENT))
	    (Setq TENT (Cons ILIST TENT))
	  )
	)
	(Setq
	  tent (Subst
		 (Cons 73 (item 74 aent))
		 (Assoc 74 tent)
		 tent
	       )
	)
	(EntMake (Reverse TENT))
      )
    )
  )

					;-----------------------------------------------------
					; Find True last entity
					;-----------------------------------------------------

  (Defun LASTENT (/ E0 EN)
    (Setq E0 (EntLast))
    (While (Setq EN (EntNext E0))
      (Setq E0 EN)
    )
    E0
  )

					;-----------------------------------------------------
					; See if a block is explodable. Return T if it is, 
					; otherwise return nil
					;-----------------------------------------------------

  (Defun EXPLODABLE (BNAME / B expld)
    (vl-load-com)
    (setq BLOCKS (vla-get-blocks
		   (vla-get-ActiveDocument (vlax-get-acad-object))
		 )
    )

    (vlax-for B	BLOCKS
      (if (and (= :vlax-false (vla-get-islayout B))
	       (= (strcase (vla-get-name B)) (strcase BNAME))
	  )
	(setq expld (= :vlax-true (vla-get-explodable B)))
      )
    )
    expld
  )


					;-----------------------------------------------------
					; Burst one entity
					;-----------------------------------------------------

  (Defun BURST-ONE (BNAME    /	      BENT     ANAME	ENT
		    ATYPE    AENT     AGAIN    ENAME	ENT
		    BBLOCK   SS-COLOR SS-LAYER SS-LTYPE	mirror
		    ss-mirror	      mlast
		   )
    (Setq
      BENT   (EntGet BNAME)
      BLAYER (ITEM 8 BENT)
      BCOLOR (ITEM 62 BENT)
      BBLOCK (ITEM 2 BENT)
      BCOLOR (Cond
	       ((> BCOLOR 0) BCOLOR)
	       ((= BCOLOR 0) "BYBLOCK")
	       ("BYLAYER")
	     )
      BLTYPE (Cond ((ITEM 6 BENT))
		   ("BYLAYER")
	     )
    )
    (Setq ELAST (LASTENT))
    (If	(and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
      (Progn
	(Setq ANAME BNAME)
	(While (Setq
		 ANAME (EntNext ANAME)
		 AENT  (EntGet ANAME)
		 ATYPE (ITEM 0 AENT)
		 AGAIN (= "ATTRIB" ATYPE)
	       )
	  (bump "Converting attributes")
	  (ATT-TEXT AENT)
	)
      )
    )
    (Progn
      (bump "Exploding block")
      (acet-explode BNAME)
					;(command "_.explode" bname)
    )
    (Setq
      SS-LAYER (SsAdd)
      SS-COLOR (SsAdd)
      SS-LTYPE (SsAdd)
      ENAME    ELAST
    )
    (While (Setq ENAME (EntNext ENAME))
      (bump "Gathering pieces")
      (Setq
	ENT   (EntGet ENAME)
	ETYPE (ITEM 0 ENT)
      )
      (If (= "ATTDEF" ETYPE)
	(Progn
	  (If (BITSET (ITEM 70 ENT) 2)
	    (ATT-TEXT ENT)
	  )
	  (EntDel ENAME)
	)
	(Progn
	  (If (= "0" (ITEM 8 ENT))
	    (SsAdd ENAME SS-LAYER)
	  )
	  (If (= 0 (ITEM 62 ENT))
	    (SsAdd ENAME SS-COLOR)
	  )
	  (If (= "BYBLOCK" (ITEM 6 ENT))
	    (SsAdd ENAME SS-LTYPE)
	  )
	)
      )
    )
    (If	(> (SsLength SS-LAYER) 0)
      (Progn
	(bump "Fixing layers")
	(Command
	  "_.chprop" SS-LAYER "" "_LA" BLAYER "")
      )
    )
    (If	(> (SsLength SS-COLOR) 0)
      (Progn
	(bump "Fixing colors")
	(Command
	  "_.chprop" SS-COLOR "" "_C" BCOLOR "")
      )
    )
    (If	(> (SsLength SS-LTYPE) 0)
      (Progn
	(bump "Fixing linetypes")
	(Command
	  "_.chprop" SS-LTYPE "" "_LT" BLTYPE "")
      )
    )
  )

					;-----------------------------------------------------
					; BURST MAIN ROUTINE
					;-----------------------------------------------------

  (Defun BURST (nmBlq / SS1)
    (setq PSFLAG (if (= 1 (caar (vports)))
		   1
		   0
		 )
    )
    (Setq SS1
	   (SsGet "x"
		  (list (cons 0 "INSERT") (cons 2 nmBlq) (cons 67 PSFLAG))
	   )
    )
    (If	SS1
      (Progn
	(Setvar "highlight" 0)
	(terpri)
	(Repeat
	  (SsLength SS1)
	   (Setq ENAME (SsName SS1 0))
	   (SsDel ENAME SS1)
	   (BURST-ONE ENAME)
	)
	(princ "\n")
      )
    )
  )

					;-----------------------------------------------------
					; BURST COMMAND
					;-----------------------------------------------------
  (while (not para)
    (if
      (setq
	ent (car (entsel "\nSelect a sample of blocks to explode..."))
      )
       (if (= (cdr (assoc 0 (setq lstent (entget ent)))) "INSERT")
	 (setq nmBlq (cdr (assoc 2 lstent))
	       para  T
	 )
	 (princ
	   "\n*** SELECTED OBJECT IS NOT A BLOCK ***\Please, try again..."
	 )
       )
       (princ
	 "\n*** NOTHING SELECTED ***\Please, try again..."
       )
    )
  )
  (if nmBlq
    (BURST nmBlq)
  )

  (acet-error-restore)
  (princ)

)

Edited January 18 by GLAVCVS

January 20

Hi all, those codes are perfect thank you! It doesn't matter that it creates a duplicate for the purpose of my task.

Thanks again.

Sign In

Lisp to Select Blocks and Explode

Recommended Posts

andy_06

GLAVCVS

andy_06

andy_06

LanloyLisp

Lee Mac

GLAVCVS

andy_06

Join the conversation

Tutorials

Forums

Activity