|
[code]
http://www.theswamp.org/index.php?topic=43457.msg486915#msg486915
(defun c:Test (/ color ss i sn obj lst name)
(vl-load-com)
;;; Tharwat 27. Dec. 2012 ;;;
(or 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)
)
[/code] |
|