[编程申请]：如何取得指定层名中颜色号

xialai

2. (defun c:ccolor        (/ es en el a)
   
3.   (princ "请选择对象，修改颜色bylayer为绝对颜色号")
   
4.   (setq        es (ssget)
   
5.         a  0
   
6.         en ""
   
7.         el nil
   
8.         fl nil
   
9.   )
   
10.   (while (/= en nil)
    
11.     (setq en (ssname es a)
    
12.           el (cons en el)
    
13.           a  (1+ a)
    
14.     )
    
15.   )
    
16.   (setq        el (cdr el)
    
17.         fl (cdr (assoc '8 (entget (car el))))
    
18.         el (cdr el)
    
19.   )
    
20.   (repeat (- a 2)
    
21.     (setq en (cdr (assoc '8 (entget (car el))))
    
22.           fl (strcat en "," fl)
    
23.           el (cdr el)
    
24.     )
    
25.   )
    
26.   ;可见层名变量为fl
    
27.   ;请把层名为fl的颜色号赋值给变量cc
    
28.   (princ)
    
29. )

(defun c:ccolor        (/ es en el a)<br />   (princ "请选择对象，修改颜色bylayer为绝对颜色号")<br />   (setq        es (ssget)<br />         a  0<br />         en ""<br />         el nil<br />         fl nil<br />   )<br />   (while (/= en nil)<br />     (setq en (ssname es a)<br />           el (cons en el)<br />           a  (1+ a)<br />     )<br />   )<br />   (setq        el (cdr el)<br />         fl (cdr (assoc '8 (entget (car el))))<br />         el (cdr el)<br />   )<br />   (repeat (- a 2)<br />     (setq en (cdr (assoc '8 (entget (car el))))<br />           fl (strcat en "," fl)<br />           el (cdr el)<br />     )<br />   )<br />   ;可见层名变量为fl<br />   ;请把层名为fl的颜色号赋值给变量cc<br />   (princ)<br /> )

lsjjm

REFER TO:
[php]
(defun c:test ()
  ;(vl-load-com)
  (setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (setq ent (car (entsel "\nSelect entity of special layer: ")))
  (setq lay (vla-item lays (cdr (assoc 8 (entget ent)))))
  (setq col (vla-get-color lay))
)
[/php]

eachy

2. 
   
3. (defun c:test (/ ss sl el lay col)
   
4.   (if (setq ss (ssget))
   
5.     (progn
   
6.       (setq sl (sslength ss))
   
7.       (while (> sl 0)
   
8.         (setq el  (entget (ssname ss (setq sl (1- sl))))
   
9.               lay (cdr (assoc 8 el))
   
10.               col (cdr (assoc 62 (tblsearch "layer" lay)))
    
11.         )
    
12.         (if (not (assoc 62 el));;2004以上可能还有 420 430 组码
    
13.           (entmod (append el (list (cons 62 col))))
    
14.         )
    
15.       )
    
16.     )
    
17.   )
    
18.   (princ)
    
19. )

<br /> (defun c:test (/ ss sl el lay col)<br />   (if (setq ss (ssget))<br />     (progn<br />       (setq sl (sslength ss))<br />       (while (> sl 0)<br />         (setq el  (entget (ssname ss (setq sl (1- sl))))<br />               lay (cdr (assoc 8 el))<br />               col (cdr (assoc 62 (tblsearch "layer" lay)))<br />         )<br />         (if (not (assoc 62 el));;2004以上可能还有 420 430 组码<br />           (entmod (append el (list (cons 62 col))))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

xialai

谢谢楼上的二位,程序瞎完成,,
1. 加上所以实体归为一层
2. 加上line变trace程序,
可向业主提供dwg图纸
程序如下,请高手优化,本人其实不很懂"
(DEFUN C:cccolor (/ ss en el lay)
  (if(setq ss(ssget))
    (WHILE(setq        en(ssname ss 0))
      (setq ss(ssdel en ss))       
        (setq el(entget en)
            lay(cdr(assoc 8 el))
            laytb(tblsearch "layer" lay)
         )
      (setq cn 1)
        (if(assoc 62 laytb)
        (setq cn(cdr(assoc 62 laytb)))
        )
      (command "_change" en "" "p" "C" cn "")
    )
  )
)