LISP to change colors inside of selected blocks

[K Baden]

Good morning everyone! I am looking for help creating a LISP that will allow the user to select blocks, and then change all entities within the block to the "ByLayer" color, then change all hatching within the block to ByBlock color. 

 

I would assume it would be easiest to just change everything first, then change the hatching color. Does anyone have something like this laying around? 

 

Thanks in advance for any help!!

[dlanorh]

Try the attached.

It will only work in Full Autocad running under windows.

You cannot select blocks on locked layers.

If the block contains attributes then an attsync will be required to update the blockrefs

Can be problematic when applied to Dynamic Blocks. 

 

The lisp asks for a selection of blocks, finds the block in the block table and updates the color property for each entity in the block. 

 

 

ColourByLayer.lsp

[kpblc]

Another one:

(vl-load-com)
(defun c:chcol (/ adoc layers selset blk_lst blk_def)
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (setq layers (mapcar (function
                                  (lambda (layer)
                                    (list layer
                                          (mapcar (function
                                                    (lambda (prop / tmp)
                                                      (setq tmp (vlax-get-property layer (car prop)))
                                                      (vl-catch-all-apply (function (lambda () (vlax-put-property layer (car prop) (cdr prop)))))
                                                      (cons (car prop) tmp)
                                                      ) ;_ end of lambda
                                                    ) ;_ end of function
                                                  (list (cons "lock" :vlax-false)
                                                        (cond "freeze"
                                                              :vlax-false
                                                              ) ;_ end of cond
                                                        ) ;_ end of list
                                                  ) ;_ end of mapcar
                                          ) ;_ end of list
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ((lambda (/ res) (vlax-for item (vla-get-layers adoc) (setq res (cons item res))) res))
                                ) ;_ end of mapcar
                 selset (mapcar (function (lambda (x) (vla-get-effectivename (vlax-ename->vla-object x))))
                                ((lambda (/ tab item)
                                   (repeat (setq tab  nil
                                                 item (sslength selset)
                                                 ) ;_ end setq
                                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                     ) ;_ end of repeat
                                   ) ;_ end of lambda
                                 )
                                ) ;_ end of mapcar
                 ) ;_ end of setq
           (foreach item selset
             (if (not (member item blk_lst))
               (setq blk_lst (cons item blk_lst))
               ) ;_ end of if
             ) ;_ end of foreach
           (foreach item blk_lst
             (if (equal (vla-get-isxref (setq blk_def (vla-item (vla-get-blocks adoc)))) :vlax-false)
               (progn (vlax-for sub blk_def
                        (vla-put-color sub
                                       (if (wcmatch (strcase (vla-get-objectname sub)) "*HATCH*")
                                         0 ; acByBlock
                                         256 ; acByLayer
                                         ) ;_ end of if
                                       ) ;_ end of vla-put-color
                        ) ;_ end of vlax-for
                      ) ;_ end of progn
               ) ;_ end of if
             ) ;_ end of foreach
           (foreach item layer
             (foreach pr (cdr layer)
               (vl-catch-all-apply (function (lambda () (vlax-put-property item (car pr) (cdr pr)))))
               ) ;_ end of foreach
             ) ;_ end of foreach
           (vla-regen adoc acactiveviewport)
           (vla-endundomark adoc)
           ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

I didn't test it.