求一小段代码：指定颜色的对象转到指定的图层
如题，想请大师帮忙写一小段代码：把选择集中，颜色 1 的对象转到 A 层，颜色 2 的转到 B 层，............................
对象转到改层后，颜色、线宽、线型都随层。
随便帮看一下我改的程序，能不能再优化一下，主要是前置时有点慢。谢谢！
(defun c:2()
(setq ss (ssget"i"))
(command "layer" "m" "2虚线" "c" "251" "" "lw" "0.13" "" "l" "DASHED" "" ""
"draworder"(ssget "x" '((8 . "2虚线")))"" "f")
(if ss(command "change" ss "" "P" "la" "2虚线" "c" "byl" "lw" "byl" "lt" "byl" ""
"draworder"(ssget "x" '((8 . "2虚线")))"" "f"))(princ))
本帖最后由 gufeng 于 2012-7-28 11:14 编辑
669423907 发表于 2012-7-27 21:40 http://bbs.mjtd.com/static/image/common/back.gif
我改成这样了：
;按色归层（gufeng 2012.07.27）
(defun c:zh(/ COLOR C_LAYER DZB ENAME I SS SubUpd) ...(defun c:zh (/ COLOR C_LAYER DZB ENAME I SS SubUpd SS_CHANGE)
;;_根据组码修改图元
;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))
(defun SubUpd (ename tylst / e_data c n)
(if (= (type ename) 'ENAME)
(setq e_data (entget ename))
)
(foreach n tylst
(if (setq c (assoc (car n) e_data))
(setq e_data (subst n c e_data))
(setq e_data (append e_data (list n)))
)
)
(entmod e_data)
(princ)
)
(setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 255) (-4 . "and>")))) ;_选择颜色从1到255的 需要定义255以外的自行修改
(if ss
(progn
(setq ss_change (ssadd)) ;_定义修改过的选择集 用于最后修改 颜色 线型 线宽 随层
(setq dzb '((1 "0") (8 "2虚线") (2 "螺纹"))) ;_定义颜色与图层对照表
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值
(if (setq color (assoc color dzb)) ;_如果颜色在 对照表dzb 中存在就修改
(progn
(setq c_layer (cadr color)) ;_根据颜色获取到需要转换的图层
(SubUpd ename (list (cons 8 c_layer))) ;_修改图层
(setq ss_change (ssadd ename ss_change)) ;_把图元名添加到修改过的选择集
)
)
)
(if (> (sslength ss_change) 0) ;_如果有修改过的继续修改 线型 线宽 随层
(command "change" ss_change "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层
)
)
)
(princ)
) 无人问津啊！ [图层] 自动修改图层颜色（索引颜色）http://bbs.mjtd.com/thread-93873-1-1.html
改下就好，没下载kaixin的程序 仲文玉 发表于 2012-7-27 10:47 static/image/common/back.gif
[图层] 自动修改图层颜色（索引颜色）http://bbs.mjtd.com/thread-93873-1-1.html
改下就好，没下载kaixin ...
倒过来咋搞啊?美女！ 现在怎么都喜欢悬赏啊？不管自己有币没币都悬，其实只要问题说明清楚，不悬也有很多热心人在帮，不然觉得太假。 soly2006 发表于 2012-7-27 11:12 static/image/common/back.gif
现在怎么都喜欢悬赏啊？不管自己有币没币都悬，其实只要问题说明清楚，不悬也有很多热心人在帮，不然觉得太 ...
把选择集中，颜色 1 的对象转到 A 层，颜色 2 的转到 B 层，
对象转到改层后，颜色、线宽、线型都随层。
不知还有哪里描述不清的.............
本帖最后由 gufeng 于 2012-7-27 14:59 编辑
;;_2012年7月27日14时54分34秒 By ls
(defun c:tt (/ COLOR C_LAYER DZB ENAME I SS SubUpd)
;;_根据组码修改图元
;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))
(defun SubUpd (ename tylst / e_data c n)
(if (= (type ename) 'ENAME)
(setq e_data (entget ename))
)
(foreach n tylst
(if (setq c (assoc (car n) e_data))
(setq e_data (subst n c e_data))
(setq e_data (append e_data (list n)))
)
)
(entmod e_data)
(princ)
)
(setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 7) (-4 . "and>")))) ;_选择颜色从1到7的
(if ss
(progn
(setq dzb '((1 "A") (2 "B") (3 "C") (4 "自定义1") (5 "自定义2") (6 "自定义3") (7 "自定义4"))) ;_定义颜色与图层对照表
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值
(setq c_layer (cadr (assoc color dzb))) ;_根据颜色获取到需要转换的图层
(SubUpd ename (list (cons 8 c_layer))) ;_修改图层
)
(command "change" ss "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层
)
)
(princ)
)
非常感谢 gufeng 大师的帮助。手机登录中，晚上再试。 本帖最后由 669423907 于 2012-7-27 21:44 编辑
gufeng 发表于 2012-7-27 14:57 http://bbs.mjtd.com/static/image/common/back.gif
我改成这样了：
;按色归层（gufeng 2012.07.27）
(defun c:zh(/ COLOR C_LAYER DZB ENAME I SS SubUpd)
;;_根据组码修改图元
;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))
(defun SubUpd (ename tylst / e_data c n)
(if (= (type ename) 'ENAME)
(setq e_data (entget ename))
)
(foreach n tylst
(if (setq c (assoc (car n) e_data))
(setq e_data (subst n c e_data))
(setq e_data (append e_data (list n)))
)
)
(entmod e_data)
(princ)
)
(setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 7) (-4 . "and>")))) ;_选择颜色从1到7的
(if ss
(progn
(setq dzb '((1 "0") (8 "2虚线") (2 "螺纹"))) ;_定义颜色与图层对照表
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值
(setq c_layer (cadr (assoc color dzb))) ;_根据颜色获取到需要转换的图层
(SubUpd ename (list (cons 8 c_layer))) ;_修改图层
)
(command "change" ss "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层
)
)
(princ)
)
上图了，麻烦gufeng大师再帮看看。谢谢你。
提示：
选择对象:
; 错误: DXF 组不正确: (8)