[编程交流] 标题栏属性颜色L

(setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
(setq atts (vlax-safearray->list (vlax-variant-value (vlax-invoke-method blk 'GetAttributes)) ))
(setq cnt 0)
(repeat (length atts)
 (setq att (nth cnt atts))
 (cond
   ((= (vlax-get-property att 'TagString) "TITLE_1")(vlax-put-property att 'Color acred))
   ((= (vlax-get-property att 'TagString) "TITLE_2")(vlax-put-property att 'Color acgreen))
   ((= (vlax-get-property att 'TagString) "TITLE_3")(vlax-put-property att 'Color acblue))
   )
 (setq cnt (+ cnt 1))
 )

(defun c:attcol ( / col lst sel )
   ;; Tags/Colours
   (setq lst '(("TITLE_1" . 1) ("TITLE_2" . 2) ("NUMBER" . 3) ("TAG1" . 4) ("TAG2" . 5)))
   
   (if (setq sel (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
       (foreach att (vlax-invoke (vlax-ename->vla-object (ssname sel 0)) 'getattributes)
           (if (setq col (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
               (if (vlax-write-enabled-p att) (vla-put-color att col))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

(defun C:test ( / Lst SS e grp enx )
 (setq Lst ; adjust for personal needs
   '( ; assoc list of (<TagName> . <Index Color>) ; note: <TagName> is case sensitive
     ("AttTag1" . 1)
     ("AttTag2" . 2)
     ("AttTag3" . 3)
     ("AttTag3" . 4)
   )
 )
 (and
   (not (prompt "\nPick the titleblock: "))
   (setq SS (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
   (setq e (ssname SS 0))
   (while (/= "SEQEND" (cdr (assoc 0 (entget (setq e (entnext e))))))
     (and
       (setq grp (assoc (cdr (assoc 2 (setq enx (entget e)))) Lst))
       (entmod (append (vl-remove-if '(lambda (x) (member (car x) '(62 420 430))) enx) (list (cons 62 (cdr grp)))))
     )
   )
 )
 (princ)
)