修改属性颜色的三种方法（代码）

newer · 发表于 2016-9-5 16:19:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

1、交互选取属性实体修改颜色（VLISP）

(defun c:attcol (/ col ent obj)
(vl-load-com)
(if (setq col (acad_colordlg 256))
(while (progn
(setq ent (car (nentsel "\nSelect Attribute to Change: ")))
(cond
((eq 'ENAME (type ent))
(if (eq "AcDbAttribute" (vla-get-ObjectName (setq obj
(vlax-ename->vla-object ent)
)
)
)
(not (vla-put-color obj col))
t
)
)
)
)
)
)
(princ)
)

2、可以一次性选择多个块，修改全部属性的颜色（AUTOLISP ENTMOD方法）

(defun c:attcol2 (/ i col ss ent elst)
(if (and
(setq i -1
col (acad_colordlg 256)
)
(setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
)
(while (setq ent (ssname ss (setq i (1+ i))))
(while (/= "SEQEND" (cdr (assoc 0 (setq elst (entget (setq ent
(entnext ent)
)
)
)
)
)
)
(entmod (if (assoc 62 elst)
(subst
(cons 62 col)
(assoc 62 elst)
elst
)
(append
elst
(list (cons 62 col))
)
)
)
)
)
)
(princ)
)

(defun c:attcol2 (/ i col ss ent elst) 
  (if (and 
        (setq i -1 
              col (acad_colordlg 256) 
        ) 
        (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))) 
      ) 
    (while (setq ent (ssname ss (setq i (1+ i)))) 
      (while (/= "SEQEND" (cdr (assoc 0 (setq elst (entget (setq ent 
                                                                 (entnext ent) 
                                                           ) 
                                                   ) 
                                        ) 
                               ) 
                          ) 
             ) 
        (entmod (if (assoc 62 elst) 
                  (subst 
                    (cons 62 col) 
                    (assoc 62 elst) 
                    elst 
                  ) 
                  (append 
                    elst 
                    (list (cons 62 col)) 
                  ) 
                ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

3、开通过对话框选择属性修改颜色

修改属性颜色的三种方法（代码）

[it618postdisplay>0][sell=5]

(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)
)

(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) 
)

[/sell]
[/it618postdisplay]

HLCAD · 发表于 2016-9-5 16:51:26

这几天收获不少，热心版主教了我们许多东西

lucas3 · 发表于 2016-9-5 16:55:23

谢谢N版，向N版学习

yoyoho · 发表于 2016-9-5 18:12:55

感谢 N版分享程序!!!!!

q3_2006 · 发表于 2016-9-5 20:58:44

这个厉害...

zytyd · 发表于 2016-9-6 02:31:51

好好学习---------------------

819534890 · 发表于 2016-9-6 10:58:39

学习学习学习

怪叔叔 · 发表于 2016-9-6 14:31:31

好的谢谢了！

shuaier · 发表于 2016-9-11 10:35:04

测试下功能！

qjcpj · 发表于 2016-9-13 17:24:05

学习学习学习

tmwall · 发表于 2016-9-19 19:44:48

感谢版主分享，，，，，，，，，，，，，，

TanK_ZZH · 发表于 2016-11-4 07:58:23

向大师学习

spp_wall · 发表于 2016-11-19 11:29:24

支持！！！！！！！谢谢！！！！！！！

sachindkini · 发表于 2016-11-19 14:08:08

see hidden contents

Michael527 · 发表于 2016-11-20 20:33:35

谢谢楼主的分享

账号		自动登录	找回密码
密码			立即注册

[每日一码] 修改属性颜色的三种方法（代码）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分