按顏色分層(紅色指定到0層並將色改為紅色)
請教 highflybir龙龙仔 板主以下內容是兩位所提供的內容，
在下若是想把1號色的"1"號層搬到"0"並將顏色改成1號色的紅色。
該如何著手修改
請指教。
在下用很笨的方法
(command "-layer" "color" 1"0" "")
(if (setq ss (ssget "X"'((8 . "1"))))
(command ".chprop" ss "" "LA" "0" "c" "1" "")
將圖搬到0層改顏色為紅，但是此方法無法在圖塊中搬動
(defun C:DDDD (/ *DOC *OBJ *LAY blocks layers)
(setvar "CMDECHO" 0)
(vl-load-com)
(setq *OBJ (vlax-get-acad-object))
(setq *DOC (vla-get-activedocument *OBJ))
(setq *LAY (vla-get-layers *DOC)) ;取得層集合
(table)
(setq blocks (vla-get-blocks *DOC)) ;取得塊集合
(vlax-for block blocks ;遍歷塊集合
(vlax-for n block ;遍歷單個塊
(ccb n)
)
)
(setvar "CMDECHO" 1)
(princ)
)
(defun ccb (object / colour laynam laycol)
(setq colour (itoa (vla-get-color object))) ;取得物體顏色號
(cond
( (or (= colour "256") (= colour "0")) ;如果物體顏色隨層或隨塊
(setq laynam (vla-get-layer object)) ;取得物體所在層名
(setq laycol (cdr (assoc laynam layers)));取得層顏色
(setq colour (itoa laycol))
(ML)
)
( (ML)
(vla-put-color object 256) ;否則改變物體顏色為隨層
)
)
(vla-put-layer object colour) ;對物體改層到顏色號層
)
(defun ML (/ layobj)
(if (not (assoc colour layers)) ;如果顏色號不在圖層表中
(progn
(setq layers (cons (cons colour laycol) layers))
;重新構造圖層表
(setq layobj (vla-add *LAY colour ) ) ;創建顏色號圖層
(vla-put-color layobj colour)
;對顏色號層賦色
)
)
)
(defun table (/ name color Nname)
(vlax-for n *LAY ;遍歷層集合
(setq name (vla-get-name n)) ;取得層名
(setq color (vla-get-color n)) ;取得層顏色
(setq layers (cons (cons name color) layers));獲得層名和顏色號表
(setq Nname (read name))
(if (= (type Nname) (type 1)) ;如果層名是整數
(if (= (strlen (itoa Nname)) (strlen name))
(if (and (> Nname 0) (< Nname 256)) ;並且>0,<256
(if (/= color Nname) ;如果層顏色不等於層名
(vla-put-color n Nname) ;則改層顏色為層名
)
)
)
)
)
)
页:
[1]