Blocks: change nested object color to "by block" (but main block color remains "by layer")

[hpimprint]

I have a drawing full of blocks ( and all block have color is "by layer").

Every block inside has nested objects and (this is the problem) nested object color is set to a color.

I need to change all nested objects color to "by block" (but main block layer must remain "by layer"): so all nested objects will have the same color of main blocks layer they are inside.

 

here attached an example to test.

test per stress.4 originale.dwg

[Steven P]

Try this, it will set most of a block attributes to byblock. It can do a bit more than just colours but you should be able to work out what to change to make it do more.

 

Apologies to most people on here, I copied this years ago but didn't make a note of where I found it, I can't post a link to the original

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 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) ;;;;this part colour byblock
;;          (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
;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

 

[rlx]

Not sure if this is what you want but my appie returns this :

 

 

BlockByBlock.lsp

[hpimprint]

rlx: do you have to select every block one by one or is it possible to select all drawing blocks together?

[rlx]

when you press the select button just type 'all' when it asks for selection

[hpimprint]

rlx: when i actvate your lisp, the lisp gui appear and disappear immedialty giving an error. maybe is not compatible with autocad 2013?

[rlx]

no problems here with version 2016 / 2017 so what's the error exactly?

[hpimprint]

here what is there written

 

Command: _appload BlockByBlock BBB.lsp successfully loaded.
BlockByBlock BBB.lsp successfully loaded.
Command:
RlxBlockByBlock - RLX nov 2020
Command:
RlxBlockByBlock - RLX nov 2020
Command:
Command: BBB
*error* : no function definition: SAVE_DIALOG_DATA
Command:

[rlx]

try adding these functions to the lisp file :

(defun Save_Dialog_Data      (%tl) (mapcar '(lambda (x) (eval (car x))) %tl))
(defun Reset_Dialog_Data (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd))
(defun Set_Dialog_Tiles      (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl))

 

I have more lisp programs (loaded at startup) using these functions so probably never noticed them missing. Hope this helps...

[hpimprint]

thank you. have i to put them at the beginnning before the "(defun c:BBB ( /...." ?

 

in the script i see you wrote that lisp. fantastic work. how much time did you need to write it?

 

 

 

 

 

 

 

[rlx]

Its not realy that important where you put the code but at the beginning is fine. Not sure how much time I spent on this , probably a couple of days spread out over a couple of weeks. Sometimes parts of code can be recycled so I take one of my other apps , saveas and after that its a matter of cut-copy-paste & modify and sometimes I need to do a little research and stealing ;-)

[hpimprint]

did you write other script about blocks, layers,.... ?

 

 

 

 

 

 

 

 

[rlx]

Not realy ... I've seen a lot of posts on this forum about layers & blocks and I believe Lee Mac has written a lot of cool stuff like a layer app but the only app for layers I once wrote was how to get rid of layers (by using dxf and change the dxf file afterwards) but that has become obsolete since the layer merge command was added to AutoCad. I rather try to get the base right instead of having to clean up afterwards. The few things I did write for blocks are hard to drive and rarely used and only ment for fun and condition training for my last remaining functioning brain cell.

[hpimprint]

it works! thank you very much!

a question: when you choose "by layer" or "by block" the rectangle in script window  becomee black. is it possible to have the ink yellow so to see the word "by blck2 in the black?