[討論]如何用lisp將圖塊的顏色由"ByLayer"更改成"ByBlock"或"強制色"？

如題！如果圖面中圖塊的顏色是"ByLayer"，但我想更換圖塊所屬之圖層並又保持原本的圖塊顏色(ex:圖面中有20種圖塊分屬20個圖層，想把他整理到某一圖層中)，lisp的語法要如何撰寫？換言之，如何用lisp進到圖塊編輯器裡修改，或是有其他的指令可以達到相同的效果？請各位先進不吝指教！謝謝～

強制更改顏色你可以參考以下這網頁討論文：
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/block-colour-change-for-lisp/td-p/1629195

代碼:

; TIP1127.LSP: BCOLOR.LSP Change Block Color (c)1995, Dean Langmaid
; With some edits

;**********Routine to change the color of a block**********
(defun C:BCOLOR (/ CLR CNT CMD EN1 EN2 EG1 EG2 NAM SS1 YN)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;---Get the block to modify---
(while (null EN1)
(setq EN1 (entsel "\nSelect block to modify: "))
(if EN1
(progn
(setq EN1 (car EN1)
EG1 (entget EN1)
)
(if (= (cdr (assoc 0 EG1)) "INSERT")
(redraw EN1 3)
(progn
(redraw EN1 3)
(setq EN1 nil)
(princ "\nItem selected is not a block.")
)
)
)

(princ "\nNothing selected. Try again.")
)
)
;---Check for layer change---
(initget "Yes No")
(setq YN (getkword "\nChange entities to layer 0 : "))
;---Check for color---
(while (null CLR)
(initget "? RED YELLOW GREEN CYAN BLUE MAGENTA WHITE BYLAYER BYBLOCK")
(setq CLR (getint "\nColor for entities/? for list/: ")
CLR (cond ((null CLR) 256)
((and (= (type CLR) 'INT) (< -1 CLR 257)) CLR)
((= CLR "?") (LSTCDS))
((= CLR "RED") 1)
((= CLR "YELLOW") 2)
((= CLR "GREEN") 3)
((= CLR "CYAN") 4)
((= CLR "BLUE") 5)
((= CLR "MAGENTA") 6)
((= CLR "WHITE") 7)
((= CLR "BYBLOCK") 0)
((= CLR "BYLAYER") 256)
(t (and (princ "\nBad value, try again.") nil))
))
)
;---Loop through entities in the block---
(setq NAM (cdr (assoc 2 EG1))
EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
)
(PRBLK EN2 NAM)

(setvar "CMDECHO" CMD)
(princ)
)
;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
(setq CNT 0)
(while EN2
(setq CNT (1+ CNT)
EG2 (entget EN2)
EN2 (entnext (cdr (assoc -1 EG2)))
)
(grtext -2 (strcat NAM " block entity # " (itoa CNT)))

;---Check for nested blocks---
(if (= (cdr (assoc 0 EG2)) "INSERT")
(progn
(setq NM2 (cdr (assoc 2 EG2))
EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
)
(PRBLK EN3 NM2)
)

(progn
;---Check color---
(if (assoc 62 EG2)
(setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
(setq EG2 (append EG2 (list (cons 62 CLR))))
)
(entmod EG2)

;---Check layer---
(if (and (= YN "Yes") (/= (cdr (assoc 8 EG2)) "0"))
(progn
(setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
(entmod EG2)
)
)
)
)
)
---Update all blocks in the drawing---
(setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
CNT 0)
(if SS1 (progn
(setq C (- (sslength SS1) 1)) ; set counter
(while (>= C CNT) ; while entities in the list
(setq EN1 (ssname SS1 CNT))
(setq CNT (1+ CNT))
(entupd EN1)
);end while C
);progn
);if SS1
);defun

;********Subroutine to list the options*************
(defun LSTCDS ()
(if textpage (textpage) (textscr))
(princ "\n ")
(princ "\n Color number | Standard meaning ")
(princ "\n ________________|____________________")
(princ "\n | ")
(princ "\n 0 | ")
(princ "\n 1 | Red ")
(princ "\n 2 | Yellow ")
(princ "\n 3 | Green ")
(princ "\n 4 | Cyan ")
(princ "\n 5 | Blue ")
(princ "\n 6 | Magenta ")
(princ "\n 7 | White ")
(princ "\n 8...255 | -Varies- ")
(princ "\n 256 | ")
(princ "\n \n\n\n")
(getint "\nColor number: ")
)

(princ "\n\tLoaded BCOLOR.LSP. Type BCOLOR to begin.")
(princ); end bcolor.lsp

感謝蘋果爸費心找到參考資料～
請容我研究研究，
有心得後再向各位報告～