Jump to content

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


hpimprint

Recommended Posts

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

Link to comment
Share on other sites

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                        ;;
;;------------------------------------------------------------;;

 

Link to comment
Share on other sites

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:

Link to comment
Share on other sites

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...

Link to comment
Share on other sites

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?

 

 

 

 

 

 

 

Link to comment
Share on other sites

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 ;-)

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...