[编程交流] 更改la的属性块

(defun c:chgabla (/ ss ly doc)
 ;;    Tharwat 27.May.2014    ;;
 (if (and (/= (setq ly (getstring t "\n Specify Layer name :")) "")
          (if (not (tblsearch "LAYER" ly))
            (progn (alert (strcat "Layer name < " ly " > is not found !!")) nil)
            t
          )
          (princ "\n Select attributed blocks to change layer of Attributes ")
          (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     )
   (progn (vla-startUndomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
          ((Lambda (i / sn e)
             (while (setq sn (ssname ss (setq i (1+ i))))
               (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget sn)))))
               (while (setq e (entnext e))
                 (entmod (subst (cons 8 ly) (assoc 8 (entget e)) (entget e))))
               (foreach x (vlax-invoke (vlax-ename->vla-object sn) 'getattributes) (vla-put-layer x ly)[color="#f4a460"](vla-put-color x 256)[/color])
             )
           )
            -1
          )
          (vla-Endundomark doc)
   )
 )
 (princ)
)(vl-load-com)