求一小段代码：指定颜色的对象转到指定的图层

669423907

如题，想请大师帮忙写一小段代码：
把选择集中，颜色 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

669423907 发表于 2012-7-27 21:40
我改成这样了：
;按色归层（gufeng 2012.07.27）
(defun c:zh(/ COLOR C_LAYER DZB ENAME I SS SubUpd) ...

2. (defun c:zh (/ COLOR C_LAYER DZB ENAME I SS SubUpd SS_CHANGE)
   
3. ;;_根据组码修改图元
   
4. ;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))
   
5. (defun SubUpd (ename tylst / e_data c n)
   
6. (if (= (type ename) 'ENAME)
   
7. (setq e_data (entget ename))
   
8. )
   
9. (foreach n tylst
   
10. (if (setq c (assoc (car n) e_data))
    
11. (setq e_data (subst n c e_data))
    
12. (setq e_data (append e_data (list n)))
    
13. )
    
14. )
    
15. (entmod e_data)
    
16. (princ)
    
17. )
    
18. (setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 255) (-4 . "and>")))) ;_选择颜色从1到255的 需要定义255以外的自行修改
    
19. (if ss
    
20. (progn
    
21. (setq ss_change (ssadd)) ;_定义修改过的选择集 用于最后修改 颜色 线型 线宽 随层
    
22. (setq dzb '((1 "0") (8 "2虚线") (2 "螺纹"))) ;_定义颜色与图层对照表
    
23. (setq i -1)
    
24. (while (setq ename (ssname ss (setq i (1+ i))))
    
25. (setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值
    
26. (if (setq color (assoc color dzb)) ;_如果颜色在 对照表dzb 中存在就修改
    
27. (progn
    
28. (setq c_layer (cadr color)) ;_根据颜色获取到需要转换的图层
    
29. (SubUpd ename (list (cons 8 c_layer))) ;_修改图层
    
30. (setq ss_change (ssadd ename ss_change)) ;_把图元名添加到修改过的选择集
    
31. )
    
32. )
    
33. )
    
34. (if (> (sslength ss_change) 0) ;_如果有修改过的继续修改   线型 线宽 随层
    
35. (command "change" ss_change "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层
    
36. )
    
37. )
    
38. )
    
39. (princ)
    
40. )

(defun c:zh (/ COLOR C_LAYER DZB ENAME I SS SubUpd SS_CHANGE)<br /> ;;_根据组码修改图元<br /> ;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))<br /> (defun SubUpd (ename tylst / e_data c n)<br /> (if (= (type ename) 'ENAME)<br /> (setq e_data (entget ename))<br /> )<br /> (foreach n tylst<br /> (if (setq c (assoc (car n) e_data))<br /> (setq e_data (subst n c e_data))<br /> (setq e_data (append e_data (list n)))<br /> )<br /> )<br /> (entmod e_data)<br /> (princ)<br /> )<br /> (setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 255) (-4 . "and>")))) ;_选择颜色从1到255的 需要定义255以外的自行修改<br /> (if ss<br /> (progn<br /> (setq ss_change (ssadd)) ;_定义修改过的选择集 用于最后修改 颜色 线型 线宽 随层<br /> (setq dzb '((1 "0") (8 "2虚线") (2 "螺纹"))) ;_定义颜色与图层对照表<br /> (setq i -1)<br /> (while (setq ename (ssname ss (setq i (1+ i))))<br /> (setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值<br /> (if (setq color (assoc color dzb)) ;_如果颜色在 对照表dzb 中存在就修改<br /> (progn<br /> (setq c_layer (cadr color)) ;_根据颜色获取到需要转换的图层<br /> (SubUpd ename (list (cons 8 c_layer))) ;_修改图层<br /> (setq ss_change (ssadd ename ss_change)) ;_把图元名添加到修改过的选择集<br /> )<br /> )<br /> )<br /> (if (> (sslength ss_change) 0) ;_如果有修改过的继续修改   线型 线宽 随层<br /> (command "change" ss_change "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层<br /> )<br /> )<br /> )<br /> (princ)<br /> )

669423907

无人问津啊！

仲文玉

[图层] 自动修改图层颜色（索引颜色）http://bbs.mjtd.com/thread-93873-1-1.html
改下就好，没下载kaixin的程序

669423907

仲文玉 发表于 2012-7-27 10:47
[图层] 自动修改图层颜色（索引颜色）http://bbs.mjtd.com/thread-93873-1-1.html
改下就好，没下载kaixin ...

倒过来咋搞啊?美女！

soly2006

现在怎么都喜欢悬赏啊？不管自己有币没币都悬，其实只要问题说明清楚，不悬也有很多热心人在帮，不然觉得太假。

669423907

soly2006 发表于 2012-7-27 11:12
现在怎么都喜欢悬赏啊？不管自己有币没币都悬，其实只要问题说明清楚，不悬也有很多热心人在帮，不然觉得太 ...

把选择集中，颜色 1 的对象转到 A 层，颜色 2 的转到 B 层，
对象转到改层后，颜色、线宽、线型都随层。

不知还有哪里描述不清的.............

gufeng

1. 
   
2. ;;_2012年7月27日14时54分34秒 By ls
   
3. (defun c:tt (/ COLOR C_LAYER DZB ENAME I SS SubUpd)
   
4. ;;_根据组码修改图元
   
5. ;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))
   
6. (defun SubUpd (ename tylst / e_data c n)
   
7. (if (= (type ename) 'ENAME)
   
8. (setq e_data (entget ename))
   
9. )
   
10. (foreach n tylst
    
11. (if (setq c (assoc (car n) e_data))
    
12. (setq e_data (subst n c e_data))
    
13. (setq e_data (append e_data (list n)))
    
14. )
    
15. )
    
16. (entmod e_data)
    
17. (princ)
    
18. )
    
19. (setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 7) (-4 . "and>")))) ;_选择颜色从1到7的
    
20. (if ss
    
21. (progn
    
22. (setq dzb '((1 "A") (2 "B") (3 "C") (4 "自定义1") (5 "自定义2") (6 "自定义3") (7 "自定义4"))) ;_定义颜色与图层对照表
    
23. (setq i -1)
    
24. (while (setq ename (ssname ss (setq i (1+ i))))
    
25. (setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值
    
26. (setq c_layer (cadr (assoc color dzb))) ;_根据颜色获取到需要转换的图层
    
27. (SubUpd ename (list (cons 8 c_layer))) ;_修改图层
    
28. )
    
29. (command "change" ss "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层
    
30. )
    
31. )
    
32. (princ)
    
33. )
    

<br /> ;;_2012年7月27日14时54分34秒 By ls<br /> (defun c:tt (/ COLOR C_LAYER DZB ENAME I SS SubUpd)<br /> ;;_根据组码修改图元<br /> ;;_(AT_E:SubUpd (car(entsel)) (list (cons 8 "1") (cons 62 4)))<br /> (defun SubUpd (ename tylst / e_data c n)<br /> (if (= (type ename) 'ENAME)<br /> (setq e_data (entget ename))<br /> )<br /> (foreach n tylst<br /> (if (setq c (assoc (car n) e_data))<br /> (setq e_data (subst n c e_data))<br /> (setq e_data (append e_data (list n)))<br /> )<br /> )<br /> (entmod e_data)<br /> (princ)<br /> )<br /> (setq ss (ssget '((-4 . "<and") (-4 . ">=") (62 . 1) (-4 . "<=") (62 . 7) (-4 . "and>")))) ;_选择颜色从1到7的<br /> (if ss<br /> (progn<br /> (setq dzb '((1 "A") (2 "B") (3 "C") (4 "自定义1") (5 "自定义2") (6 "自定义3") (7 "自定义4"))) ;_定义颜色与图层对照表<br /> (setq i -1)<br /> (while (setq ename (ssname ss (setq i (1+ i))))<br /> (setq color (cdr (assoc 62 (entget ename)))) ;_获取颜色值<br /> (setq c_layer (cadr (assoc color dzb))) ;_根据颜色获取到需要转换的图层<br /> (SubUpd ename (list (cons 8 c_layer))) ;_修改图层<br /> )<br /> (command "change" ss "" "p" "c" "bylayer" "lt" "bylayer" "lw" "bylayer" "") ;_颜色 线型 线宽 随层<br /> )<br /> )<br /> (princ)<br /> )<br />

669423907

非常感谢 gufeng 大师的帮助。手机登录中，晚上再试。

669423907

gufeng 发表于 2012-7-27 14:57

我改成这样了：
;按色归层（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)