Set color to "ByBlock" for entities inside blocks

[deisajavier]

Hi guys, need a little bit of help here.
I want to change color to "ByBlock" for all entities inside of a selected block, including entities on nested blocks and excluding blocks color properties only.

What I mean is color of all blocks (selected one and nested) must remain whitout changes.

It's possible to do something like this?

I've got this code, but only works for a single block and doesnt change nested items.

(defun c:test (/ ss e blk doc)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if
  (setq ss (ssget ":L" '((0 . "INSERT"))))
  (repeat (setq i (sslength ss))
     (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
     (setq blk (vla-item (vla-get-blocks doc) (vla-get-Effectivename e)))
     (vlax-for x blk
       (vla-put-color x 0)
     )
  )
)
(vla-regen doc acAllViewports)
(princ)
)

[Moshe-A · Accepted solution]

check this, did not test it

(defun c:test (/ ss e blk doc)
 (if (setq ss (ssget ":L" '((0 . "INSERT"))))
  (repeat (setq i (sslength ss))
   (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
    
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   (setq blk (vla-item (vla-get-blocks doc) (vla-get-Effectivename e)))
   (vlax-for x blk
    (if (eq (vla-get-objectname x) "AcDbBlockReference")
     (color->byblock doc x) 
     (vla-put-color x 0)
    )
   )
  )
 )
  
 (vla-regen doc acAllViewports)
 (princ)
)

(defun color->byblock (doc x / doc blk)
 (setq blk (vla-item (vla-get-blocks doc) (vla-get-Effectivename x)))
  
 (vlax-for x blk
  (if (eq (vla-get-objectname x) "AcDbBlockReference")
   (color->byblock doc x) ; recursion
   (vla-put-color x 0)
  )
 )
)

[deisajavier]

Works great!

Thanks Moshe-A

[Moshe-A]

thank you, happy to hear

don't stop here, give some Likes

[Luke.vansonsbeek]

Hi guys,

I really need this code, but first of all, how do i activate this LISP? I am new into those routines. Can someone explain me how i insert this into my Autocad software and how i can use it?

[Kent1Cooper]

Lee Mac has a good tutorial about that, >here<.

The command name is what immediately follows the c: at the top, so you should probably change that from "test" to something more meaningful.

[3dwannab]

Here's a modified EditBlock.lsp by gileCAD, so ALL credit goes to him. The main thing here is that it changes blocks inside of blocks and works with dynamic blocks.

NOTES:

- Removed the UI so the command runs with the settings that I use the most.

WHAT THE MODIFIED VERSION DOES:

- Set the layer to 0

- Sets the colour, linetye, lineweight and transparency of everything to "ByBlock"

- Sets the line type scale to 1.

- Sets the units of the blocks to millimetres.

- Removed the vla-put-PlotStyleName function.

- This works with nested blocks as per Gilles' original code.

- This works with dynamic blocks as per the original code by Gilles because otherwise resetting a dynamic block that was changed reverts to its original.

MODE:

- There are 4 main modes to choose from.

'ByBlock' 'ByLayer' 'ByLayer0LTScale1' and 'LTScale1' which can be run with the same commands.

Method "ByLayer"

- Transparency set to "ByLayer"

- Layer is set to "0"

- Colour is set to ByLayer

- Line type is set to "ByLayer"

- Line weight is se to ByLayer

- Line type scale is set to 1

Method "ByBlock"

- Transparency set to "ByBlock"

- Layer is set to "0"

- Colour is set to ByBlock

- Line type is set to "ByBlock"

- Line weight is se to ByBlock

- Line type scale is set to 1

Method "ByLayer0LTScale1"

- Layer is set to "0"

- Line type scale is set to 1

Method "LTScale1"

- Line type scale is set to 1

Note: You can easily add to this if you like.

The processAllSwitch switch used in the BKByBlockKeepHatch command:

- Will set all to byblock like the method "ByBlock", except that it will not process hatches.

CREDIT GO TO GILLIES

- Full credit goes to Gillies for the original script. I just butchered it to make it work without a dialog box.

[andrea_ricciNMVSG]

Hello,

thank you for your lisp.

How do avoid the unit change?

Is there also a way to set the block parameters "Scale Uniformly" → yes and "Allow Exploding" → no?

Thank you very much

[3dwannab]

;; Removed unit change
;  (if (< 16.1 (read (substr (getvar "acadver") 1 4)))  ;_ Unit?
;    (if (/= (setq i_unt (vla-get-units bloc)) unt)
;      (vla-put-Units bloc 4) ;; Millimeters
;    )
;  )

Add ; to each of the lines like the above..

For exploding, use the attached and the scale lisp too.

[andrea_ricciNMVSG]

Thank you so much!