Leaderboard

I have this as a start for you. I copied the basis from this from somewhere - either this forum of from Lee Mac (I lost the reference, happy to refer to it if anyone knows). Command attnorm puts most blocks as layer 0 and colour byblock. If it was me I would put the blocks on appropriate layers, Arch, MechD, MechW and so on, and use layer colours for the block colours.. then your question will be how to move blocks to a layer dependent on name? (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:attnormred (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) (setq myblocklayer "0") (setq myblockcolour 10) ; (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) ;; (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

Try the following: (defun c:setblockcolour ( / _blkcolour c e l ) (defun _blkcolour ( n c / a e x ) (if (and (setq e (tblobjname "block" n)) (not (member n l))) (progn (while (setq e (entnext e)) (entmod (append (vl-remove-if '(lambda ( x ) (member (car x) '(62 420 430))) (setq x (entget e)) ) c ) ) (if (= "INSERT" (cdr (assoc 0 x))) (_blkcolour (cdr (assoc 2 x)) c) ) ) (setq l (cons n l)) ) ) nil ) (if (setq c (acad_truecolordlg 1)) (progn (while (progn (setvar 'errno 0) (setq e (car (entsel "\nSelect Block: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (= 'ename (type e)) (if (= "INSERT" (cdr (assoc 0 (entget e)))) (_blkcolour (cdr (assoc 2 (entget e))) c) (princ "\nObject is not a block.") ) ) ) ) ) (command "_.regen") ) ) (princ) )