[LISP程序]：xlbc = 实体按色改层

狂刀

2. 
   
3.   [FONT=courier new]
   
4. ;| xlbc = 实体按色改层(lbc),可自动生成新图层并改图层颜色，自动修改实体色随层
   
5. |;
   
6. (defun c:xlbc (/ ss n e ent la la$ k)
   
7.   (princ "\n 实体按色改层! ----by 狂刀.2005.11")
   
8.   (if (setq ss (ssget))
   
9.     (repeat (setq n (sslength ss))
   
10.       (setq e        (ssname ss (setq n (1- n)))
    
11.             ent        (entget e))
    
12.       (or (setq la (cdr (assoc 62 ent)))
    
13.           (setq la (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))
    
14.       (setq la$ (itoa la)
    
15.             k   (tblsearch "layer" la$))
    
16.       (entmod(append (entget e) (list (cons 8 la$) (cons 62 256))))
    
17.       (if (not k)
    
18.         (entmod        (append        (entget (tblobjname "layer" la$))(list (cons 62 la))))
    
19.       )
    
20.     )
    
21.   )
    
22.   (princ)
    
23. )
    
24.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;| xlbc = 实体按色改层(lbc),可自动生成新图层并改图层颜色，自动修改实体色随层<br /> |;<br /> (defun c:xlbc (/ ss n e ent la la$ k)<br />   (princ "\n 实体按色改层! ----by 狂刀.2005.11")<br />   (if (setq ss (ssget))<br />     (repeat (setq n (sslength ss))<br />       (setq e        (ssname ss (setq n (1- n)))<br />             ent        (entget e))<br />       (or (setq la (cdr (assoc 62 ent)))<br />           (setq la (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))<br />       (setq la$ (itoa la)<br />             k   (tblsearch "layer" la$))<br />       (entmod(append (entget e) (list (cons 8 la$) (cons 62 256))))<br />       (if (not k)<br />         (entmod        (append        (entget (tblobjname "layer" la$))(list (cons 62 la))))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />   [/FONT]<br />

doubao

程序很精炼， 值得学习。

1、语句
(or (setq la (cdr (assoc 62 ent)))
          (setq la (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 ent)))))))
这个赋值方法以前没用过，相当精炼。

2、原来entmod 只需要append 相应的点对即可。 以前一直以为必须用 subst 替换要修改的点对才行。

3、原来entmod 还可以自动生成新的层。

LNASER

谢谢搂住

zzqxuexicad

不错

dwg001

狂刀锋利，让人爱！