AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.

[分享]改所有圖元為單一顏色

+5
rickyyang
長陳
wateraustin
shackle_2005
LUCAS_LAI
9 posters

向下

[分享]改所有圖元為單一顏色 Empty [分享]改所有圖元為單一顏色

發表 由 LUCAS_LAI 2021-08-06, 15:25

;;只改變圖元顏色,不改變圖層顏色
;;清楚了解AUTOCAD模型是由圖塊組成
;;即模型空間,圖紙空間皆為圖塊

[程式下載網址 回覆可見]


代碼:


(vl-load-com)
(defun C:CH_COLOR_LAI (/      ATT    COL    COLOROBJ  COLUMNS
       DOC    ENT1   HOLDECHO   N  N1 NAME
       OBJ    ROWS   SS    X
      )

;;; 改MTEXT顏色                                
;;; by Luis Esquivel - http://www.draftteam.com
;;; function to scan a mtext and make the color uniform
;;; (put-uniform-mtext-color (vlax-ename->vla-object (car (entsel))) 2)
  (defun PUT-UNIFORM-MTEXT-COLOR (VLA_MTEXT    COLORNUM /
  CONT   ENAME    FLAG     I
  LET   TXT1    TXTSTR
 )

    ;;By LUCAS_LAI "ACAD_PROXY_ENTITY"
    (setq ENAME (vlax-vla-object->ename VLA_MTEXT))
    (setq TXTSTR "")
    (foreach X (entget ENAME)
      (if (or (= (car X) 3)
      (= (car X) 1)
      (= (car X) 304)
  )
 (setq TXTSTR (strcat TXTSTR (cdr X)))
      )
    )
    ;;====================================================
    (setq TXT1 "")
    (setq CONT 1)
    (if (/= TXTSTR "")
      (repeat (strlen TXTSTR)
 (setq LET (substr TXTSTR CONT 1))
 (if (= LET "\")
  (progn
    (if (= (substr TXTSTR (+ CONT 1) 1) "C")
      (progn
 (setq I (+ CONT 2))
 (while (/= (substr TXTSTR I 1) ";")
  (setq I (1+ I))
 )
 (setq TXT1 (strcat TXT1
   "\\C"
   (itoa COLORNUM)
   ";"
   (substr TXTSTR (+ I 1) 1)
   )
 )
 (setq CONT (+ I 2))
      )
      (setq FLAG t)
    )
  )
  (progn
    (setq TXT1 (strcat TXT1 LET))
    (setq CONT (1+ CONT))
  )
 )
 (if FLAG
  (progn
    (setq TXT1 (strcat TXT1 LET))
    (setq CONT (1+ CONT))
    (setq FLAG NIL)
  )
 )
      )
    )
    (vla-put-textstring VLA_MTEXT TXT1)
    (vla-put-color VLA_MTEXT COLORNUM)
  )

  (defun DO_IT (BLK)
    (vla-put-color BLK COL)
  )

  (setq HOLDECHO (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (vl-cmdf "_.undo" "BE")
  (if (setq COL (acad_colordlg 7)) ;選顏色
    (progn
      (vl-cmdf "_.-LAYER" "U" "*" "")
      (setq COLOROBJ (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "AutoCAD.AcCmColor."
       (substr (getvar "acadver") 1 2)
       )
     )
      )
      (vla-put-colorindex COLOROBJ COL)
      (setq
 DOC (vla-get-activedocument (vlax-get-acad-object))
      )

      ;|改圖層顏色
  (vlax-for OBJ (vla-get-layers DOC)
    (DO_IT OBJ)
  )
  |;

      ;;把"ACAD_PROXY_ENTITY"炸開
      (setvar 'QAFLAGS 5)
      (if (setq
    SS (ssget "_X"
      (list '(0 . "ACAD_PROXY_ENTITY")
    (cons 410 (getvar "CTAB"))
      )
       )
  )
 (vl-cmdf "_.explode" SS "")
      )
      (setvar 'QAFLAGS 0)

      ;;遍壢圖塊
      (vlax-for BLK (vla-get-blocks DOC) ;圖塊定義
 (vlax-for OBJ BLK ;改圖塊參考顏色
  (if (and (= (vla-get-objectname OBJ) "AcDbBlockReference")
   (= (vla-get-hasattributes OBJ) :vlax-true)
      )
    (mapcar '(lambda (X) ;改圖塊參考屬性顏色
       (setq ATT (vlax-variant-value ((eval X) OBJ)))
       (if (safearray-value ATT)
 (foreach ENT1 (vlax-safearray->list ATT)
   (DO_IT ENT1)
 )
       )
     )
    '(vla-getattributes vla-getconstantattributes)
    )
  )
  (DO_IT OBJ)
  (setq NAME (vla-get-objectname OBJ))

  ;;處理MTEXT,MLEADER中文字
  (if (or (= NAME "AcDbMText")
  (and
    (= NAME "AcDbMLeader")
    (= (vla-get-stylename OBJ) "Standard")
  )
      )
    (PUT-UNIFORM-MTEXT-COLOR OBJ COL)
  )

  ;;處理MLEADER中leaderlinecolor
  (if (= NAME "AcDbMLeader")
    (vl-catch-all-error-p
      (vl-catch-all-apply
 'vla-put-leaderlinecolor
 (list OBJ COL)
      )
    )
  )

  ;;處理HATCH中SOLID--漸層色
  (if (and (= NAME "AcDbHatch")
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
 'vla-get-gradientcolor1
 (list OBJ)
       )
     )
   )
      )
    (progn
      (vla-put-gradientcolor1 OBJ COLOROBJ)
      (vla-put-gradientcolor2 OBJ COLOROBJ) ;漸層底色
    )
  )

  ;;   處理表格顏色(只處理了2種)
  ;;   表格還有很多種顏色
  ;;   SetBackgroundColor (2)
  ;;   SetBackgroundColorNone (2)
  ;;   SetCellBackgroundColor (3)
  ;;   SetCellBackgroundColorNone (3)
  ;;   SetCellContentColor (3)
  ;;   SetCellGridColor (4)
  ;;   SetContentColor (2)
  ;;   SetContentColor2 (4)
  ;;   SetGridColor (3)
  ;;   SetGridColor2 (4)

  (if (= NAME "AcDbTable")
    (progn
      (vla-put-regeneratetablesuppressed OBJ :vlax-true)
      (setq COLUMNS (vla-get-columns OBJ))
      (setq ROWS (vla-get-rows OBJ)
    N 0
    N1 0
      )
      (repeat COLUMNS
 (repeat ROWS
  (vla-setcellcontentcolor OBJ N N1 COLOROBJ) ;改內容色
  (setq N (1+ N))
 )
 (setq N 0
      N1 (1+ N1)
 )
      )

      ;;改框色
      ;;使框色可見  
      (vla-setgridvisibility
 OBJ
 (+ achorzbottom    achorzinside     achorztop
   acvertinside    acvertleft     acvertright
  )
 (+ acdatarow acheaderrow actitlerow)
 :vlax-true
      )

      ;;再改框色
      (vla-setgridcolor
 OBJ
 (+ achorzbottom    achorzinside     achorztop
   acvertinside    acvertleft     acvertright
  )
 (+ acdatarow acheaderrow actitlerow)
 COLOROBJ
      )
      (vla-put-regeneratetablesuppressed OBJ :vlax-false)
    )
  )

  ;;處理尺寸顏色(可能有欠一些)
  (if (or (and (> (strlen NAME) 8)
       (= "Dimension"
  (substr NAME (- (strlen NAME) 8))
       )
  )
  (= NAME "AcDbLeader")
      )
    (progn
      (vl-catch-all-error-p
 (vl-catch-all-apply 'vla-put-textcolor (list OBJ COL))
      )
      (vl-catch-all-error-p
 (vl-catch-all-apply
  'vla-put-extensionlinecolor
  (list OBJ COL)
 )
      )
      (vl-catch-all-error-p
 (vl-catch-all-apply
  'vla-put-dimensionlinecolor
  (list OBJ COL)
 )
      )
      (vl-catch-all-error-p
 (vl-catch-all-apply
  'vla-put-textfillcolor
  (list OBJ COL)
 )
      )
    )
  )
 )
      )

      ;;移動一下表格框色才會改變
      (if (setq
    SS (ssget "_X"
      (list '(0 . "ACAD_TABLE")
    (cons 410 (getvar "CTAB"))
      )
       )
  )
 (progn
  (vl-cmdf "_.MOVE" SS "" "NON" "0,0" "NON" "@0.001,0")
  (vl-cmdf "_.MOVE" SS "" "NON" "0,0" "NON" "@-0.001,0")
 )
      )
      (vlax-release-object COLOROBJ)
      (vlax-release-object DOC)
      (vl-cmdf "_.REGENALL")
      (vl-cmdf "_.undo" "e")
      (setvar "cmdecho" HOLDECHO)
    )
  )
  (princ)
)
(princ
  "\nType CH_COLOR_LAI 改所有圖元為單一顏色,By LUCAS_LAI"
)
(princ)

LUCAS_LAI
LUCAS_LAI
一般會員
一般會員

文章總數 : 33
年齡 : 57
來自 : 桃園市
職業 : 工程師
愛好 : 看動漫
個性 : 內向
使用年資 : 25年以上,但最近10年少用
使用版本 : 2011
經驗值 : 771
威望值 : 97
注冊日期 : 2021-05-27
男 摩羯座 龍

http://lucas-lai.ys168.com/

Tiger&蘋果爸 likes this post

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 shackle_2005 2021-08-06, 20:07

感謝, 測試
shackle_2005
shackle_2005
初級會員
初級會員

文章總數 : 231
年齡 : 51
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 5942
威望值 : 340
注冊日期 : 2010-09-20
男 獅子座 豬

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 wateraustin 2022-01-12, 22:34

學習  vsual-lisp   color
wateraustin
wateraustin
一般會員
一般會員

文章總數 : 64
年齡 : 56
來自 : 台南
職業 : soho 3d,2d 模具
愛好 : pop music,movie
個性 : very good EQ
使用年資 : 30
使用版本 : 2011
經驗值 : 4684
威望值 : 15
注冊日期 : 2010-09-16
男 水瓶座 馬

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 長陳 2022-01-14, 09:53

工作剛好有需要用到,感謝分享
長陳
長陳
一般會員
一般會員

文章總數 : 29
年齡 : 41
來自 : 高雄
職業 : 工程
愛好 : cad
個性 : ok
使用年資 : 2
使用版本 : 2017
經驗值 : 4481
威望值 : 0
注冊日期 : 2010-10-24
男 天蝎座 猴

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 rickyyang 2022-02-08, 23:47

感謝大大無私地分享......感恩
rickyyang
rickyyang
專屬會員
專屬會員

文章總數 : 179
年齡 : 43
來自 : 台北
職業 : 營建暨室內裝修工程管理
愛好 : 喜愛黃金獵犬、哈士奇
個性 : 誠信、正義、穩健
使用年資 : 15
使用版本 : AutoCAD 2018 & 2023
經驗值 : 3722
威望值 : 36
注冊日期 : 2014-11-11
男 射手座 馬

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 as688633 2022-06-21, 16:58

感謝 分享
as688633
as688633
一般會員
一般會員

文章總數 : 14
年齡 : 45
來自 : taipei
職業 : 繪圖員
愛好 : 看書
個性 : 積極
使用年資 : 10
使用版本 : 2020
經驗值 : 2390
威望值 : 0
注冊日期 : 2016-05-10
女 處女座 蛇

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 chengshunyi 2022-06-22, 13:05

感謝分享...
chengshunyi
chengshunyi
高級會員
高級會員

文章總數 : 45
年齡 : 56
來自 : 台北市文山區
職業 : 建築規劃
愛好 : 散步
個性 : 溫和
使用年資 : 15
使用版本 : 2018
經驗值 : 4780
威望值 : 75
注冊日期 : 2010-07-04
男 處女座 馬

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 白宗禮 2022-06-30, 18:01

白宗禮
白宗禮
專屬會員
專屬會員

文章總數 : 24
年齡 : 42
來自 : 台灣
職業 : 學生
個性 :
經驗值 : 4983
威望值 : 0
注冊日期 : 2009-05-23
男 天蝎座 羊

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 virage7676 2022-07-01, 09:02

測試 看看
virage7676
virage7676
一般會員
一般會員

文章總數 : 26
年齡 : 45
來自 : 台中市北屯區
職業 : 自由業
愛好 : 慢跑
個性 : 寡言
使用年資 : 10
使用版本 : CAD2006
經驗值 : 3815
威望值 : -9
注冊日期 : 2012-08-04
男 射手座 龍

回頂端 向下

[分享]改所有圖元為單一顏色 Empty 回復: [分享]改所有圖元為單一顏色

發表 由 virage7676 2022-07-01, 09:39

不知是否可以只對選取改色就好
virage7676
virage7676
一般會員
一般會員

文章總數 : 26
年齡 : 45
來自 : 台中市北屯區
職業 : 自由業
愛好 : 慢跑
個性 : 寡言
使用年資 : 10
使用版本 : CAD2006
經驗值 : 3815
威望值 : -9
注冊日期 : 2012-08-04
男 射手座 龍

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]改所有圖元為單一顏色 Ioaoe110 [分享]改所有圖元為單一顏色 2020-310 [分享]改所有圖元為單一顏色 Oiu15010 [分享]改所有圖元為單一顏色 2020-211 [分享]改所有圖元為單一顏色 Ia15010 [分享]改所有圖元為單一顏色 Aizyao10
[分享]改所有圖元為單一顏色 Uos15010 [分享]改所有圖元為單一顏色 BPl3tjj [分享]改所有圖元為單一顏色 Ziao1510 [分享]改所有圖元為單一顏色 Oo-2-110 [分享]改所有圖元為單一顏色 Zuoiy_10 [分享]改所有圖元為單一顏色 Aizyao11
[分享]改所有圖元為單一顏色 Aoe1-111 [分享]改所有圖元為單一顏色 Uos15011 [分享]改所有圖元為單一顏色 RQvAhqF [分享]改所有圖元為單一顏色 YdKelqY [分享]改所有圖元為單一顏色 K410yWG