块改色lisp_晓东CAD家园-论坛-A/VLISP-修改属性颜色的三种方法（代码）-1、交互选取属性实体修改颜色（VLISP）2、可以一次性选择多个块，修改全部属性的颜色（AUTOLISP ENTM...

(defun c:attcol3 (/ unique dcl_write Set_Img CATT DCTAG DLST ENT FNAME I ITM

OBJ OLST PTR SS

)                       ; By Lee McDonnell (Lee Mac)  ~

; 28.12.2009

(vl-load-com)

(setq fname "LMAC_ATTCOL_V1.0.dcl")

(or

*attcol*

(setq *attcol* 1)

)                                       ; Default Colour

(defun unique (lst / result)

(reverse (while (setq itm (car lst))

(setq lst (vl-remove itm lst)

result (cons itm result)

)

)

)

)

(defun dcl_write (fname / wPath ofile)

(if (not (findfile fname))

(if (setq wPath (findfile "ACAD.PAT"))

(progn

(setq wPath (vl-filename-directory wPath))

(or

(eq "\\" (substr wPath (strlen wPath)))

(setq wPath (strcat wPath "\\"))

)

(setq ofile (open (strcat wPath fname) "w"))

(foreach str '

("attcol : dialog { label = \"Attribute Colour\";" "  : text { alignment = right; label = \"Lee McDonnell 2009\"; }"

"  : list_box { label = \"Select Tags\"; key = \"tags\"; fixed_width = false;" "               multiple_select = true ; alignment = centered; }"

"  : boxed_column { label = \"Colour\";" "    : row { spacer;"

"      : button { key = \"cbut\"; width = 12; fixed_width = true; label = \"Select Colour\"; }" "      : image_button { key = \"cimg\"; alignment = centered; height = 1.5; width = 4.0;"

"                       fixed_width = true; fixed_height = true; color = 2; }"

"      spacer;"

"    }" "    spacer;"

"  }" "  spacer;"

"  ok_cancel;" "}"

)

(write-line str ofile)

)

(close ofile)

t

)                               ; File written successfully

nil

)                                       ; Filepath not Found

t

)

)                                       ; DCL file already exists

(defun Set_Img (key col)

(start_image key)

(fill_image 0 0 (dimx_tile key) (dimy_tile key) col)

(end_image)

)

(if (and

(dcl_write fname)

(setq i -1

ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))

)

)

(progn

(while (setq ent (ssname ss (setq i (1+ i))))

(foreach att (append

(vlax-safearray->list (vlax-variant-value

(vla-getAttributes

(setq obj

(vlax-ename->vla-object ent)

)

)

)

)

(cond

((vl-catch-all-error-p (setq cAtt

(vl-catch-all-apply

(function vlax-safearray->list)

(list

(vlax-variant-value

(vla-getConstantAttributes obj)

)

)

)

)

)

nil

)

(cAtt)

)

)

(setq oLst (cons (cons (vla-get-TagString att) att) oLst))

)

)

(cond

((<= (setq dcTag (load_dialog fname))

0

)

(princ "\n** Dialog File could not be Found **")

)

((not (new_dialog "attcol" dcTag))

(princ "\n** Dialog Could not be Loaded **")

)

(t

(start_list "tags")

(mapcar

(function add_list)

(setq dLst (acad_strlsort (Unique (mapcar

(function car)

oLst

)

)

)

)

)

(end_list)

(setq ptr (set_tile "tags" "0"))

(Set_Img "cimg" *attcol*)

(action_tile "cimg" (vl-prin1-to-string (quote (progn

(Set_Img "cimg"

(setq *attcol*

(cond

(

(acad_colordlg *attcol*)

)

(*attcol*)

)

)

)

)

)

)

)

(action_tile "cbut" (vl-prin1-to-string (quote (progn

(Set_Img "cimg"

(setq *attcol*

(cond

(

(acad_colordlg *attcol*)

)

(*attcol*)

)

)

)

)

)

)

)

(action_tile "tags" "(setq ptr $value)")

(action_tile "accept" "(done_dialog)")

(action_tile "cancel" "(setq ptr nil) (done_dialog)")

(start_dialog)

(unload_dialog dcTag)

(if ptr

(progn

(setq ptr (mapcar

(function (lambda (x)

(nth x dLst)

)

)

(read (strcat "(" ptr ")"))

)

)

(mapcar

(function (lambda (x)

(and

(vl-position (car x) ptr)

(vla-put-color (cdr x) *attcol*)

)

)

)

oLst

)

)

(princ "\n*Cancel*")

)

)

)

)

)

(princ)

)