明经旧藏，改一切颜色，取之于明，用之于明。

panliang9 发表于 2021-1-7 09:21:38

本帖最后由 panliang9 于 2021-1-7 09:26 编辑

龙龙仔老大的贴子，N年前得到的好东西，可惜的是，社区消失了很多贴子，包含这个。

我同事“美生 ”在原贴上做了一些改进。

chn：选中的块名后面加后缀
bb：改对象颜色，包含块，块中块等。
cn：改对象的图层,按给定的新层名，如果没有该层即新建一个。
chl：不清楚
chtl：将所有的虚线线型(hidden)对象变成隐藏线层，hidden里面。
cct：将某种特定颜色的对象，改成指定的另一种颜色

看到有人在问改块内对象颜色，就把它贴出来吧。

;;不知你会多少编程???
;;dwgblack程序还不能改属性&几何公差&引线的顏色(看谁有空补上)
;;By 龙龙仔(LUCAS)
;;将图中所有实体（包括块，嵌套块，尺寸中的无名块）变色
(defun C:chn (/ SS KEY NUM NUM0 N E LEN)
(prompt "\\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
(setq NUM(getstring "\nEnter string add:")
   NUM0 2)
(setq N 0)
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_NAME (setq E (ssname SS N)) NUM0 NUM)
(entupd E)
(setq N (1+ N))
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun #CHG_NAME (E CNUM0 CNUM / TF E1 BLKNA)
(setq TF (DXF 0 E))
(if (= TF "INSERT")
(progn
         (MODREN E CNUM0 CNUM)
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (= TF "INSERT")
               (progn
         (MODREN E CNUM0 CNUM)
         (#CHG_NAME E CNUM0 CNUM)
               )
            )
            (setq E (entnext E))
         )
)
)
)
(defun MODREN(E CNUM0 CNUM / orina newna orinaend)
(setq orina(DXF 2 E))
(setq newna(strcat orina "_" CNUM))
(if (> (strlen orina) (strlen CNUM))
(progn
   (setq orinaend(substr orina (- (strlen orina) (strlen CNUM))))
   (if (/= (strcat "_" CNUM)orinaend)
   (command "-rename" "b" orina newna)
   )
)
(command "-rename" "b" orina newna)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun #CHG_COLOR (E CNUM0 CNUM / TF E1 BLKNA)
(setq TF (DXF 0 E))
(cond
((or (= TF "INSERT")(= TF "DIMENSION"))
         (MODENT E CNUM0 CNUM)
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (or (= TF "INSERT")(= TF "DIMENSION"))
                     (#CHG_COLOR E CNUM0 CNUM)
                     (MODENT E CNUM0 CNUM)
            )
            (setq E (entnext E))
         )
)
(t (MODENT E CNUM0 CNUM))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun #CHG_LINETYPE (E CNUM0 CNUM / TF E1 BLKNA)
(setq TF (DXF 0 E))
(cond
((or (= TF "INSERT")(= TF "DIMENSION"))
         ;(MODENT E CNUM0 CNUM)
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (or (= TF "INSERT")(= TF "DIMENSION"))
                     (#CHG_LINETYPE E CNUM0 CNUM)
                     (if (or (= (DXF 6 E) "DOT1") (= (DXF 6 E) "DOT"))(MODENT E CNUM0 CNUM))
            )
            (setq E (entnext E))
         )
)
(t (if (or (= (DXF 6 E) "DOT1") (= (DXF 6 E) "DOT"))(MODENT E CNUM0 CNUM)))
)
)
;;;;;;;;;;;;;;
(defun #CHG_HIDDEN_TO (E CNUM0 CNUM / TF E1 BLKNA)
(setq TF (DXF 0 E))
(cond
((or (= TF "INSERT")(= TF "DIMENSION"))
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (or (= TF "INSERT")(= TF "DIMENSION"))
                     (#CHG_HIDDEN_TO E CNUM0 CNUM)
                     (if (or (= (DXF 6 E) "HIDDEN1") (= (DXF 6 E) "HIDDEN") (= (DXF 6 E) "HIDDEN2"))(MODENT E CNUM0 CNUM))
            )
            (setq E (entnext E))
         )
)
(t (if (or (= (DXF 6 E) "HIDDEN1") (= (DXF 6 E) "HIDDEN") (= (DXF 6 E) "HIDDEN2"))(MODENT E CNUM0 CNUM)))
)
)
;;;;;;;;;;;;;;;;;
(defun #CHG_LAYER (E CNUM0 CNUM / TF E1 BLKNA)
(setq TF (DXF 0 E))
(cond
((or (= TF "INSERT")(= TF "DIMENSION"))
         (MODENT E CNUM0 CNUM)
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (or (= TF "INSERT")(= TF "DIMENSION"))
                     (#CHG_LAYER E CNUM0 CNUM)
                     (MODENT E CNUM0 CNUM)
            )
            (setq E (entnext E))
         )
)
(t (MODENT E CNUM0 CNUM))
)
)
;;;;;;;;;;;;;;;
(defun #CHG_COLOR_TO (E CNUM0 CNUM CNUM1 / TF E1 BLKNA)
(setq TF (DXF 0 E))
(cond
((or (= TF "INSERT")(= TF "DIMENSION"))
         (if (= (DXF 62 E) CNUM1)(MODENT E CNUM0 CNUM))
         (setq BLKNA (DXF 2 E))
         (setq BLKNA (tblsearch "block" BLKNA))
         (setq E (cdr (assoc -2 BLKNA)))
         (while E
            (setq TF (DXF 0 E))
            (if (or (= TF "INSERT")(= TF "DIMENSION"))
                     (#CHG_COLOR_TO E CNUM0 CNUM CNUM1)
                     (if (= (DXF 62 E) CNUM1)(MODENT E CNUM0 CNUM))
            )
            (setq E (entnext E))
         )
)
(t (if (= (DXF 62 E) CNUM1)(MODENT E CNUM0 CNUM)))
)
)
;;;;;;;;;;;;;;;
(defun TABLE (S / D R)
(while (setq D (tblnext S (null D)))
(setq R (cons (cdr (assoc 2 D)) R))
)
)

(defun SEL_LAY (/ LAY LAY1 ID)
(setq LAY (acad_strlsort (TABLE "Layer")))
(setq ID (load_dialog "lay.dcl"))
(new_dialog "lay" ID)
(start_list "lay")
(mapcar \'add_list LAY)
(end_list)
(action_tile "lay" "(setq lay1 (nth (atoi $value) lay))")
(start_dialog)
(unload_dialog ID)
LAY1
)

(defun MODENT (E EE COL)
(setq E (entget E))
(if (= (assoc EE E) NIL)
(setq E (append E (list (cons EE COL))))
(setq E (subst (cons EE COL) (assoc EE E) E))
)
(entmod E)
)

(defun DXF (CODE ENT)
(cdr (assoc CODE (entget ENT)))
)

(defun C:bb (/ SS KEY NUM NUM0 N E LEN)
;(arxload "acetutil.arx" NIL)
(prompt "\\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
;(initget "1 2")
(setq KEY "1");(getstring "\\n<1>: "))
(if (or (= KEY "1")(= KEY ""))
(setq NUM(acad_colordlg 3) ; (acad_truecolordlg 7)
      NUM0 62) ;真色彩很少用,程序留给你写吧!
(setq NUM(getstring "\nEnter linetype name:")
      NUM0 6)
;;; (setq NUM(SEL_LAY)
;;;       NUM0 8)
)
(setq N 0)
;(acet-ui-progress "已经完成:"
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_COLOR (setq E (ssname SS N)) NUM0 NUM)
(entupd E)
;(acet-ui-progress -1)
(setq N (1+ N))
)
;(acet-ui-progress)
(princ)
)

(defun C:cn (/ SS KEY NUM NUM0 N E LEN)
(prompt "\\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
(setq NUM(getstring "\nEnter layer name:")
   NUM0 8)
(setq N 0)
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_LAYER (setq E (ssname SS N)) NUM0 NUM)
(entupd E)
(setq N (1+ N))
)
(princ)
)

(defun C:chl (/ SS KEY NUM NUM0 NUM1 N E LEN)
(prompt "\\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
(setq NUM "HIDDEN2"
   NUM0 6)
(setq N 0)
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_LINETYPE (setq E (ssname SS N)) NUM0 NUM)
(entupd E)
(setq N (1+ N))
)
(princ)
)

(defun C:chtl (/ SS KEY NUM NUM0 NUM1 N E LEN)
(prompt "\\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
(setq NUM "HIDDEN"; (getstring "\nEnter linetype name:")
   NUM0 8)
(setq N 0)
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_HIDDEN_TO (setq E (ssname SS N)) NUM0 NUM)
(entupd E)
(setq N (1+ N))
)
(princ)
)

(defun C:cct (/ SS KEY NUM NUM0 N E LEN)
(prompt "\nSelect objects:")
(if (not (setq SS (ssget)))
(setq SS (ssget ))
)
(prompt "\nSelect original colour:")
(setq NUM1 (acad_colordlg 1)
   NUM0 62)
(prompt "\nSelect colour change to:")
(setq NUM (acad_colordlg 1))
(setq N 0)
(setq LEN (sslength SS))
(setq N 0)
(repeat LEN
(#CHG_COLOR_TO (setq E (ssname SS N)) NUM0 NUM NUM1)
(entupd E)
(setq N (1+ N))
)
(princ)
)

;|
;;----lay.dcl档
lay : dialog {label="选取图层";
: list_box {
key = "lay";
height       = 20;
width          = 40;
fixed_width_font = true;
fixed_width    = true;
         }
ok_cancel;
}
|;

JHX948954875 发表于 2021-1-7 09:26:46

谢谢楼主分享

xj6019 发表于 2021-1-7 10:20:57

非常感谢分享经典好用的代码好好研究研究

tigcat 发表于 2021-1-7 12:41:24

谢谢楼主分享

999999 发表于 2021-1-7 12:49:57

顶起来，谢谢楼主的分享

hncjddd 发表于 2021-1-7 14:16:40

错误: no function definition: HIDDEN，缺少函数.

页: [1]

明经CAD社区's Archiver

明经旧藏，改一切颜色，取之于明，用之于明。