[编程交流] 块颜色

setbylayer

(defun c:Test (/ color ss i sn obj lst name)
 (vl-load-com)
 ;;; Tharwat 01. July. 2012  ;;;
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (if (eq (cdr (assoc 0 (entget sn))) "INSERT")
         (vlax-for block (setq
                           blk (vla-item
                                 (vla-get-blocks acdoc)
                                 (setq name (vla-get-EffectiveName obj))
                               )
                         )
           (if (and (eq :vlax-false (vla-get-isXref blk))
                    (if (not (member name lst))
                      (setq lst (cons name lst))
                    )
               )
             (vlax-for x blk
               (if
                 (not (eq "AcDbBlockReference" (vla-get-objectname x)))
                  (vla-put-color x color)
               )
             )
           )
         )
         (vla-put-color obj color)
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)

(defun c:test (/ attribute b blk color i lst name obj sn ss)
;;;;;            Tharwat 01. June. 2012                 ;;;;;
;;;;;              This peice of code to change all           ;;;;;
;;;;;  selected objects (Blocks / Attribted Block / Objects)   ;;;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (if (and (setq color (acad_colordlg 7 t))
          (setq ss (ssget "_:L"))
     )
   (progn
     (vla-startundomark acdoc)
     (repeat (setq i (sslength ss))
       (setq obj (vlax-ename->vla-object
                   (setq sn (ssname ss (setq i (1- i))))
                 )
       )
       (cond
         ((eq (cdr (assoc 66 (entget sn))) 1)
          (progn
            (vlax-for block (setq b (vla-item (vla-get-blocks acdoc)
                                              (cdr (assoc 2 (entget sn)))
                                    )
                            )
              (vlax-for x b (vla-put-color x color))
            )
            (foreach attribute (vlax-invoke obj 'Getattributes)
              (vla-put-color attribute color)
            )
          )
         )
         ((and (eq (cdr (assoc 0 (entget sn))) "INSERT")
               (not (member (cdr (assoc 2 (entget sn))) lst))
          )
          (progn
            (setq lst (cons (cdr (assoc 2 (entget sn))) lst))
            (vlax-for block
                      (setq blk (vla-item (vla-get-blocks acdoc)
                                          (cdr (assoc 2 (entget sn)))
                                )
                      )
              (if (eq :vlax-false (vla-get-isXref blk))
                (vlax-for x blk
                  (if
                    (not
                      (eq "AcDbBlockReference" (vla-get-objectname x))
                    )
                     (vla-put-color x color)
                  )
                )
              )
            )
          )
         )
         (t (vla-put-color obj color))
       )
     )
     (vla-regen acdoc acAllViewports)
     (vla-endundomark acdoc)
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi ")
 (princ)
)