选对象，按颜色分层
请大家帮忙改成可自行选择对象，谢谢！ 刘炎华 发表于 2023-3-5 20:23还是会将所有的对象都改了，附上图档您帮忙看下(defun c:tt ()
(princ "按对象颜色换层")
(defun Entmake-Layer(la)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 la)
)
)
)
(defun xyp-get-Color (s1 / co)
(if (setq co (xyp-DXF 62 s1))
co
(cdr (assoc 62 (tblsearch "layer" (xyp-DXF 8 s1))))
)
)
(defun xyp-dxf (code e) (cdr (assoc code (entget e))))
(setq i -1)
(if (setq ss (ssget))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq co(xyp-get-color s1))
(setq la (itoa co))
(Entmake-Layer la)
(vla-put-layer (vlax-ename->vla-object s1) la)
(vla-put-color (vlax-ename->vla-object s1) co)
)
)
(princ)
)
原贴：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=57237&highlight=%B0%B4%D1%D5
现在可以电脑上网了，贴上源码
(defun C:CN (/ *DOC *OBJ *LAY blocks layers)
(princ "按对象颜色换层")
(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)
)
)
(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) ;则改层颜色为层名
)
)
)
)
)
) 你试下看行不行！
(defun c:tt ()
(defun Entmakex-Layer (lname)
(entmakex (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 lname)
)
)
(setvar 'clayer lname)
)
(defun xyp-get-Color (s1 / co)
(if (setq co (xyp-DXF 62 s1))
co
(cdr (assoc 62 (tblsearch "layer" (xyp-DXF 8 s1))))
)
)
(defun xyp-dxf (code e) (cdr (assoc code (entget e))))
(setq i -1)
(if (setq ss (ssget))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq la (itoa (xyp-get-color s1)))
(Entmakex-Layer la)
(vla-put-layer (vlax-ename->vla-object s1) la)
)
)
(princ)
)
xyp1964 发表于 2023-3-5 14:26
版主，您帮我看下是哪里的问题呢？
提示：错误: AutoCAD 变量设置被拒绝: CLAYER "251"
yaojing38 发表于 2023-3-5 13:51
你试下看行不行！
还是会将所有的对象都改了，附上图档您帮忙看下
xyp1964 发表于 2023-3-5 20:58
谢谢版主！可以了 刘炎华 发表于 2023-3-5 21:50
谢谢版主！可以了
请问是怎么解决的？ xyp1964 发表于 2023-3-5 14:26
如果是块、嵌套块、外部参照该怎么办
页:
[1]