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

panliang9

龙龙仔老大的贴子，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 改顏色/2 改层]<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

谢谢楼主分享

xj6019

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

tigcat

谢谢楼主分享

999999

顶起来，谢谢楼主的分享

hncjddd

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