Mass Block Edit - Explode, Change Prop, Save, Close

April 28

Hello,

I am in need of some help creating a routine.

My company has many old standards and templates that are pulled from. I am attempting to clean some of these up.

We have a library of hundreds of blocks that have blocks referenced into them. Example, the "SSMH" block has another block *U8 referenced into it. You can explode the random block name and it will have the linework and text that we want.

The good thing is that they are all setup the same, so my brain went straight to a lisp routine, but my minimal lisp knowledge is unsuccessful at this time.

I would like to be able to do the below in sequence:

Select the block or blocks.

Explode the item "random block name* located at 0,0.

Select all remaining items.

Change the color to "ByBlock".

Change the line type to "Continuous".

*Change the text style to "Standard".

Save and Close the block editor.

Thanks.

Blocks to Explode.dwg

Edited April 28 by CADTerminus

April 29

You have block inside a block not sure why. You need to recreate the block with the original name, use explode twice, then Block command selecting all objects use original name and insertion point.

This was my attempt as a starting point, 1st step was objects are at Z= 1e-13. need to look at each block and check. If exploded block name becomes a "*Uxx"

Code removed see latest post.

Edited April 30 by BIGAL

April 29

See if you like this.

It sets everything ByLayer (command BTL ) or Byblock (command BTB )

And I just added textstyle to STANDARD (I hope this works well).

Now you have to select all your layers and put the color to color and linetype to whatever you need.

;;change all to 0 layer, by layer, including block and block in block 
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-to-0-layer-by-layer-including-block-and-block-in/td-p/5376995
;; Adpted by Emmanuel Delay

;; TODO!!! removing RGB true color needs to be finished

(setq
  mode "byblock"  ;; or "bylayer" or "zero"
)


;; recursive function
(defun block->0 ( blk / ent enx obj)
  (cond
    ( (member blk lst))
    ( ;; case ent: while(){ ... }; break;
      (setq ent (tblobjname "block" blk))
      (while (setq ent (entnext ent))

        (cond
          ((= mode "bylayer")
            ;; 8 => layer, 6 => linetype, 62 => color 
            (entmod (subst-append 8 "0" (subst-append 6 "BYLAYER" (subst-append 62 256 (setq enx (entget ent))))))    
            ;; linewheight requires a little more effort.  we need a vla object of ent
            (setq obj (vlax-ename->vla-object ent))
            (vla-put-Lineweight obj -1 )                   ;; -1 = "ByLayer"
			
			;; Set TextStyle  to "STANDARD"  
			(entmod (subst-append 7 "STANDARD" (setq enx (entget ent))))

          )
          ((= mode "byblock")
            ;; 8 => layer, 6 => linetype, 62 => color 
            (entmod (subst-append 8 "0" (subst-append 6 "BYBLOCK" (subst-append 62 0 (setq enx (entget ent)))))) 

            (entmod (subst-append 62 0 (setq enx (entget ent))))
            ;; remove Real color, (assoc 420), and replace it by (cons 62 0)
            (entmod (subst-real_col 420 62 0 (setq enx (entget ent))))

            ;; linewheight requires a little more effort.  we need a vla object of ent
            (setq obj (vlax-ename->vla-object ent))
            (vla-put-Lineweight obj -2 )                   ;; -2 = "ByBlock"
			
			;; Set TextStyle  to "STANDARD"  
			(entmod (subst-append 7 "STANDARD" (setq enx (entget ent))))
				
          )
        )

        (if 
          (= "INSERT" (cdr (assoc 0 enx)))
          ;; then
          (block->0 (cdr (assoc 2 enx)))
        )
      )
      (setq lst (cons blk lst))
    );; / while
  )  ;; / cond
)

(defun subst-append ( key val lst / itm )
  (if (setq itm (assoc key lst))
    (subst (cons key val) itm lst)
    (append lst (list (cons key val)))
  )
)

;; 
(defun subst-real_col ( key_orig key val lst / itm )
  (if (setq itm (assoc key_orig lst))
    (subst (cons key val) itm lst)
    (append lst (list (cons key val)))
  )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Block To byBlock
(defun c:BTB ( / ) 
  (setq mode "byblock")
  (c:blkto0)
)

;; Block To byLayer
(defun c:BTL ( / ) 
  (setq mode "bylayer")
  (c:blkto0)
)


(defun c:blkto0 ( / idx lst sel ent)
  (if 
    (setq sel (ssget '((0 . "INSERT"))))
    (repeat (setq idx (sslength sel))
      (setq ent (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
      (block->0 ent )
    )
  )
  (command "_.regen")
  (princ)
)


(defun help ( / )
  (princ "\nSelect blocks, all subentities of the block will have their layer set to 0; color, linetype and lineweight set to byBlock or ByLayer") 
  (princ "\nCommand BTB: blocks to byBlock.\nCommand BTL: blocks to ByBlock.") 
  (princ)
)
(help)

April 29

Here is what I use to set items within blocks to bylayer or byblock. I've lost the reference for where I have copied it from.

I think I would edit the blocks instead of explode and recreate them - sounds easier to do

Command: attnorm - which is a small function to run the main thing. You can modify this to set the block items to other things as required (se attnormcolour)

I wonder if this link will do the exploding part,

I think it could be incorporated into my main function below. Not got time today but will have a think

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (setq myblocklayer "0")
  (setq myblockcolour 0)
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
(defun c:attnormcolour (/ myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (setq myblocklayer "0")
  (setq myblockcolour (getint "Enter Colour Code Value (0 - 249)(253: Grey) "))
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Main Function
(defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers)
  (defun *error* (msg)
    (func_restore-layers)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
  ) ;_ end of defun

  (defun func_restore-layers ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-freeze
             (car item)
             (cdr (assoc "freeze" (cdr item)))
           ) ;_ end of vla-put-freeze
         ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of foreach
  ) ;_ end of defun

  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark

  (if (and (not (vl-catch-all-error-p
          (setq selset
            (vl-catch-all-apply
              (function
                (lambda ()
                  (ssget '((0 . "INSERT")))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of setq
       ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    selset
    ) ;_ end of and
    (progn
      (vlax-for item (vla-get-layers adoc)
        (setq
          lst_layer (cons (list item
                (cons "lock" (vla-get-lock item))
                (cons "freeze" (vla-get-freeze item))
              ) ;_ end of list
              lst_layer
          ) ;_ end of cons
        ) ;_ end of setq
        (vla-put-lock item :vlax-false)
        (vl-catch-all-apply
          '(lambda () (vla-put-freeze item :vlax-false))
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vlax-for
      (foreach blk_def
        (mapcar
          (function
            (lambda (x)
              (vla-item (vla-get-blocks adoc) x)
            ) ;_ end of lambda
          ) ;_ end of function
          ((lambda (/ res)
              (foreach item (mapcar
                (function
                  (lambda (x)
                    (vla-get-name
                      (vlax-ename->vla-object x)
                    ) ;_ end of vla-get-name
                  ) ;_ end of lambda
                ) ;_ end of function
                ((lambda (/ tab item)
                    (repeat (setq tab  nil
                        item (sslength selset)
                      ) ;_ end setq
                      (setq
                        tab
                        (cons
                          (ssname selset
                            (setq item (1- item))
                          ) ;_ end of ssname
                          tab
                        ) ;_ end of cons
                      ) ;_ end of setq
                    ) ;_ end of repeat
                    tab
                  ) ;_ end of lambda
                )
              ) ;_ end of mapcar
              (if (not (member item res))
                (setq res (cons item res))
              ) ;_ end of if
              ) ;_ end of foreach
              (reverse res)
            ) ;_ end of lambda
          )
        ) ;_ end of mapcar
        (vlax-for ent blk_def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Sets the block attributes
;;add in here other attributes to change
          (vla-put-layer ent myblocklayer)
          (vla-put-color ent myblockcolour)
          (vla-put-lineweight ent myblocklineweight)
;;          (vla-put-linetype ent myblocklinetype)
;;end of setting up block attributes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        ) ;_ end of vlax-for
      ) ;_ end of foreach
      (func_restore-layers)
      (vla-regen adoc acallviewports)
    ) ;_ end of progn
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun

April 29

Hi @CADTerminus,

Try this:

; ***********************************************************************************************
; Functions     :  EXCHS
; Description   :  Explode nested block, change properties for different entities and save it
; Author        :  SAXLLE
; Date          :  April 29, 2025
; ***********************************************************************************************

(prompt "\nTo run a LISP type: EXCHS")
(princ)

(defun c:EXCHS ( / ss len i ename bname ent obj explodedObjects j)

  (prompt "\nSelect all BLOCKS for CHANGING:")
  (setq ss (ssget (list (cons 0 "INSERT")))
	len (sslength ss)
	i 0
	)
  
  (while (< i len)
    
    (setq ename (ssname ss i)
	  bname (cdr (assoc 2 (entget ename)))
	  )
    
    (if (setq ent (tblobjname "block" bname))
      (while (/= ent nil)
	(setq ent (entnext ent))
	(if (/= ent nil)
	  (progn
	    (setq obj (vlax-ename->vla-object ent))
	    (cond
	      ((equal (vla-get-ObjectName obj) "AcDbBlockReference")
	       (if (wcmatch (vla-get-Name obj) "*U*")
		 (progn
		   (setq explodedObjects (vlax-variant-value (vla-Explode obj)))
		   (setq j 0)
		   (while (< j (vlax-safearray-get-u-bound explodedObjects 1))
		     (if (equal (vla-get-ObjectName (vlax-safearray-get-element explodedObjects j)) "AcDbText")
		       (progn
			 (vla-put-StyleName (vlax-safearray-get-element explodedObjects j) "Standard")
			 (vla-put-Color (vlax-safearray-get-element explodedObjects j) acByBlock)
			 (vla-put-LineType (vlax-safearray-get-element explodedObjects j) "Continuous")
			 )
		       (progn
			 (vla-put-Color (vlax-safearray-get-element explodedObjects j) acByBlock)
			 (vla-put-LineType (vlax-safearray-get-element explodedObjects j) "Continuous")
			 )
		       )
		     (vla-Update (vlax-safearray-get-element explodedObjects j))
		     (setq j (1+ j))
		     )
		   (vla-Delete obj)
		   )
		 )
	       )
	      
	      (t
	       (setq obj (vlax-ename->vla-object ent))
	       (if (equal (vla-get-ObjectName obj) "AcDbText")
		 (progn
		   (vla-put-StyleName obj "Standard")
		   (vla-put-Color obj acByBlock)
		   (vla-put-LineType obj "Continuous")
		   )
		 (progn
		   (vla-put-Color obj acByBlock)
		   (vla-put-LineType obj "Continuous")
		   )
		 )
	       )
	      )
	    )
	  )
	)
      )
    (setq i (1+ i))
    )
  (command "REGENALL")
  (prompt "\nThe changes has been done!")
  (princ)
  )

Best regards.

April 29

I have ignored the set bylayer and continuous rather removing the nested blocks and moving objects to the top level with correct block name which I think was the original request, can do the other 2 steps when that works. Out of the 120 blocks after running code found 20 still as *Uxx" name so something not quite right. More searching and some blocks have name of Uxx the problem is that these blocks have an effective name of Uxx, so even if nesting is removed the block will still have an anonymous name.

These blocks need a rename.

Edited April 29 by BIGAL

April 29

Likewise, if I use the first of Lee Macs examples in my link above I get about the same number of "Uxx" blocks left, run again and still half a dozen blocks left over.

I use this to return table objects (tablesearch "BLOCK") - might have to search the list for anything beginning with 'U' and do something with that?

  (defun tablesearch ( s / d r) ;;List Dimstyles
    (while (setq d (tblnext s (null d)))(setq r (cons (cdr (assoc 2 d)) r)))
  )

April 29

Like you @Steven P I was going to add a check is it a Uxx block name and if so ask for new name.

Found one problem when using explode it stops on explode a Spline will have a think about that.

Got so so close, One Uxx left behind. I removed the two shrubs as they are made up of splines, realised that when exploded the objects are not Uxx blocks so no need to change unless objects name is Uxx. On attempt 4 now, as usual twists and turns in supplied dwgs. So 2 tests check name and check after explode.

I have it stopping at the named Uxx blocks, displaying the block so you cam see what it looks like, then input correct name.

Edited April 30 by BIGAL

April 30

I wonder if this one from Lee Mac might be handy - it should return the 'U' blocks contained within a block reference?

https://lee-mac.com/getanonymousreferences.html

May 1

@Steven P You can change the name of a "Uxx" by looking for it in the block table, a "Uxx" block does not appear if checking via the Insert command. This is what I was using for top level block name change.

(if (wcmatch bname "**U##*" )
  (progn
    (setq ins (cdr (assoc 10 (entget ent))))
    (command "zoom" "c" ins 40) ; zooms to block so can see what it looks like
    (setq bnamenew (getstring (strcat "\n\n existing name " bname "  Enter new name ")))
    (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
     (if (= (vlax-get block 'name) bname)
     (vlax-put block 'name bnamenew)
     )
    )
  )
  )

I think I have to start all over again. Given the time involved so far could probably have redone each block manually by now.

May 1

check out the drawing attached to this thread

Sign In

Mass Block Edit - Explode, Change Prop, Save, Close

Recommended Posts

CADTerminus

BIGAL

Emmanuel Delay

Steven P

Saxlle

BIGAL

Steven P

BIGAL

Steven P

BIGAL

Danielm103

Join the conversation

Tutorials

Forums

Activity