征求：图层归统程序源码....

尘缘一生

问题提出：

       一：工作初始：

              我们画图初始坏境，设置了一定量图层：颜色、线型。

          二：工作过程产生新实体入层，然而，新实体的颜色、线型，并没有和初始图层完全相符。

      三：求这样功能的lisp :
      
             选择一范围内所有实体，判断每个实体的：颜色，线型；假如这样颜色和线型的图层已存在，就落去，否则，就建立这样颜色+线型的图层出来（新层名就用颜色号），并把这个实体改到新层去......；新增加的图层程序自动记录，下一实体判断要比较的图层，多了这一个.......；如此循环.......

         四：目的与结果：           
                程序处理完，保证：颜色和线型相同的实体，存在唯一的该层上。颜色不同不在该层，线型不同也不在该层。

*******************************************************************
      我在本论坛找过"按色分层”源码如下，假如如此使用，虽然按颜色分了层，但却把线型搞乱了，因此，需要完善线型问题，连线型要考虑在内一起判断......；改造成“按色、线分层”出来！

2. (defun C:DDDD (/ *DOC *OBJ *LAY blocks layers)
   
3.    (setvar "CMDECHO" 0)
   
4. (vl-load-com)
   
5.   (setq *OBJ (vlax-get-acad-object))
   
6.   (setq *DOC (vla-get-activedocument *OBJ))
   
7.   (setq *LAY (vla-get-layers *DOC))              ;取得层集合
   
8.   (table)
   
9.   (setq blocks (vla-get-blocks *DOC))            ;取得块集合
   
10.   (vlax-for block blocks           ;遍历块集合
    
11.     (vlax-for n block            ;遍历单个块
    
12.       (ccb n)
    
13.     )
    
14.   )
    
15. 
    
16. (setvar "CMDECHO" 1)
    
17.   (princ)
    
18. )
    
19. (defun ccb (object / colour laynam laycol)
    
20.   (setq colour (itoa (vla-get-color object)))    ;取得物体颜色号
    
21.   (cond            
    
22.     ( (or (= colour "256") (= colour "0"))       ;如果物体颜色随层或随块
    
23.       (setq laynam (vla-get-layer object))       ;取得物体所在层名
    
24.       (setq laycol (cdr (assoc laynam layers)))  ;取得层颜色
    
25.       (setq colour (itoa laycol))            
    
26.       (ML)                                      
    
27.     )
    
28.     ( (ML)
    
29.       (vla-put-color object 256)                 ;否则改变物体颜色为随层
    
30.     )
    
31.   )
    
32.   (vla-put-layer object colour)                  ;对物体改层到颜色号层
    
33. )
    
34. (defun ML (/ layobj)
    
35.    (if (not (assoc colour layers))                ;如果颜色号不在图层表中
    
36.      (progn
    
37.      (setq layers (cons (cons colour laycol) layers))
    
38.       
    
39.                                                            ;重新构造图层表
    
40.       (setq layobj (vla-add *LAY colour )    )   ;创建颜色号图层
    
41.       
    
42.       (vla-put-color layobj colour)
    
43.              ;对颜色号层赋色
    
44. 
    
45.    
    
46. )
    
47. 
    
48.   )
    
49. )
    
50. (defun table (/ name color Nname)
    
51.   (vlax-for n *LAY                               ;遍历层集合
    
52.     (setq name (vla-get-name n))                 ;取得层名
    
53.     (setq color (vla-get-color n))               ;取得层颜色
    
54.     (setq layers (cons (cons name color) layers));获得层名和颜色号表
    
55.     (setq Nname (read name))
    
56.     (if (= (type Nname) (type 1))                ;如果层名是整数
    
57.       (if (= (strlen (itoa Nname)) (strlen name))
    
58.         (if (and (> Nname 0) (< Nname 256))      ;並且>0,<256
    
59.           (if (/= color Nname)                   ;如果层颜色不等于层名
    
60.             (vla-put-color n Nname)              ;则改层颜色为层名
    
61. 
    
62.           )
    
63.         )
    
64.       )
    
65.     )
    
66.   )
    
67. )

(defun C:DDDD (/ *DOC *OBJ *LAY blocks layers)<br />    (setvar "CMDECHO" 0)<br /> (vl-load-com)<br />   (setq *OBJ (vlax-get-acad-object))<br />   (setq *DOC (vla-get-activedocument *OBJ))<br />   (setq *LAY (vla-get-layers *DOC))              ;取得层集合<br />   (table) <br />   (setq blocks (vla-get-blocks *DOC))            ;取得块集合<br />   (vlax-for block blocks           ;遍历块集合<br />     (vlax-for n block            ;遍历单个块<br />       (ccb n)<br />     )<br />   )<br /> <br /> (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br /> (defun ccb (object / colour laynam laycol)<br />   (setq colour (itoa (vla-get-color object)))    ;取得物体颜色号<br />   (cond             <br />     ( (or (= colour "256") (= colour "0"))       ;如果物体颜色随层或随块<br />       (setq laynam (vla-get-layer object))       ;取得物体所在层名<br />       (setq laycol (cdr (assoc laynam layers)))  ;取得层颜色<br />       (setq colour (itoa laycol))             <br />       (ML)                                      <br />     )<br />     ( (ML)<br />       (vla-put-color object 256)                 ;否则改变物体颜色为随层<br />     )<br />   )<br />   (vla-put-layer object colour)                  ;对物体改层到颜色号层<br /> )<br /> (defun ML (/ layobj)<br />    (if (not (assoc colour layers))                ;如果颜色号不在图层表中<br />      (progn <br />      (setq layers (cons (cons colour laycol) layers))<br />       <br />                                                            ;重新构造图层表<br />       (setq layobj (vla-add *LAY colour )    )   ;创建颜色号图层<br />       <br />       (vla-put-color layobj colour)<br />              ;对颜色号层赋色<br /> <br />     <br /> )<br /> <br />   ) <br /> )<br /> (defun table (/ name color Nname)<br />   (vlax-for n *LAY                               ;遍历层集合<br />     (setq name (vla-get-name n))                 ;取得层名<br />     (setq color (vla-get-color n))               ;取得层颜色<br />     (setq layers (cons (cons name color) layers));获得层名和颜色号表<br />     (setq Nname (read name))<br />     (if (= (type Nname) (type 1))                ;如果层名是整数<br />       (if (= (strlen (itoa Nname)) (strlen name))<br />         (if (and (> Nname 0) (< Nname 256))      ;並且>0,<256<br />           (if (/= color Nname)                   ;如果层颜色不等于层名<br />             (vla-put-color n Nname)              ;则改层颜色为层名<br /> <br />           )<br />         )<br />       )<br />     )<br />   )<br /> )

wzg356

颜色相同、线型不同的层如何取名区分？

下面的是通通重来一遍

2. ;按颜色+线型建层重新归拢(newla)
   
3. ;是否所有对象均有线型属性没考虑，颜色随块没考虑（我搞不定）
   
4. (defun newla ( / ss i ee obj pro1 pro2 pro3 pro4 pro5 Laname)
   
5. (setq ss(ssget))
   
6. (setq i 0)
   
7. (while (setq ee (ssname ss i))      
   
8.   (setq obj (vlax-ename->vla-object ee)
   
9.        pro1 (vlax-get-property obj "Layer")
   
10.        pro2(vlax-get-property obj "Color")
    
11.        pro3(vlax-get-property obj "Linetype")
    
12.        pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色
    
13.        pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型
    
14.     )
    
15.   (setq pro2(if (equal pro2 256) pro4 pro2));图元颜色
    
16.   (setq pro3(if (equal pro3 "ByLayer") pro5 pro3));图元线型
    
17.   (setq Laname
    
18.     (strcat
    
19.       "色" (rtos  pro2 2  0);图元颜色
    
20.       "+线"  pro3 ;图元线型
    
21.     )
    
22.   );颜色+线型的图层名
    
23.   (If (= (Tblsearch "layer" Laname) nil)
    
24.     ;;;颜色+线型取名定义新图层
    
25.     (command "-layer" "n" Laname "c" pro2 Laname "l" pro3 Laname "")        
    
26.   )
    
27. (if(equal pro1 Laname)nil(command "chprop" ee "" "la" Laname ""));;把东东放进去
    
28. (setq i (+ i 1))
    
29. )
    
30. )

;按颜色+线型建层重新归拢(newla)<br /> ;是否所有对象均有线型属性没考虑，颜色随块没考虑（我搞不定）<br /> (defun newla ( / ss i ee obj pro1 pro2 pro3 pro4 pro5 Laname)<br /> (setq ss(ssget))<br /> (setq i 0)<br /> (while (setq ee (ssname ss i))       <br />   (setq obj (vlax-ename->vla-object ee)<br />        pro1 (vlax-get-property obj "Layer")<br />        pro2(vlax-get-property obj "Color")<br />        pro3(vlax-get-property obj "Linetype")<br />        pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色 <br />        pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型<br />     )<br />   (setq pro2(if (equal pro2 256) pro4 pro2));图元颜色<br />   (setq pro3(if (equal pro3 "ByLayer") pro5 pro3));图元线型<br />   (setq Laname<br />     (strcat <br />       "色" (rtos  pro2 2  0);图元颜色<br />       "+线"  pro3 ;图元线型<br />     )<br />   );颜色+线型的图层名 <br />   (If (= (Tblsearch "layer" Laname) nil)<br />     ;;;颜色+线型取名定义新图层<br />     (command "-layer" "n" Laname "c" pro2 Laname "l" pro3 Laname "")        <br />   )<br /> (if(equal pro1 Laname)nil(command "chprop" ee "" "la" Laname ""));;把东东放进去<br /> (setq i (+ i 1))<br /> )<br /> )

尘缘一生

wzg356 发表于 2015-12-14 22:37
颜色相同、线型不同的层如何取名区分？

下面的是通通重来一遍

我仅会普通编程，见谅，不是为建立新层，是该建的建，不需要建的不建，并不动实体的层，不符合的才建立它，并把它归层过去。

        取得现已存在的：层表，颜色和线型，判断存在实体是否相符，不相符-->建立该层-->把该实体移到该层。
     关键是下一实体：
       A:要是正好符合已有的存在层，不动它  B:符合本程序新建立的层，就移动到该层  C:假如都没有符合它的层存在-->循环建立------>

wzg356

2. ;另一种，拿对象颜色 线型与已有层颜色 线型比较
   
3. ;==========================
   
4. ;取得已有层的属性表
   
5. ;返回((层名1 颜色 线型)(层名2 颜色 线型)......)
   
6. (defun getlalst ( / TBL TBL_LIST )
   
7. (while (setq TBL (tblnext "LAYER" (null TBL)))
   
8.         (setq TBL_LIST
   
9.                 (cons
   
10.                         (list
    
11.                                 (cdr (assoc 2 TBL))
    
12.                                 (cdr (assoc 62 TBL))
    
13.                                 (cdr (assoc 6 TBL))
    
14.                         )
    
15.                         TBL_LIST
    
16.                 )
    
17.         )
    
18. )
    
19. )
    
20. 
    
21. ;取得图元的图层+颜色+线型信息
    
22. ;(getenpro (car(entsel)))
    
23. ;返回(层名 颜色 线型)
    
24. (defun getenpro (ee / obj pro1 pro2 pro3 pro4 pro5)              
    
25.         (setq obj (vlax-ename->vla-object ee)
    
26.              pro1 (vlax-get-property obj "Layer")
    
27.              pro2(vlax-get-property obj "Color")
    
28.              pro3(vlax-get-property obj "Linetype")
    
29.              pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色
    
30.              pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型
    
31.     )
    
32.     (list  pro1 ;图层
    
33.             (if (equal pro2 256) pro4 pro2);图元颜色
    
34.             (if (equal pro3 "ByLayer") pro5 pro3);图元线型
    
35.     )
    
36. )
    
37. (defun c:newla1 ( / ss i ee lalst enlst co lsty lalst1 a Laname)
    
38. (setq ss(ssget))
    
39. (setq i 0)
    
40. (while (setq ee (ssname ss i))             
    
41.         (setq lalst (getlalst) lalst1 nil)
    
42.         (setq enlst (getenpro ee)
    
43.                 co  (cadr enlst);图元颜色
    
44.                 lsty (caddr enlst);图元线型
    
45.         )
    
46.         (if (member enlst lalst )
    
47.                 nil
    
48.                 (progn
    
49.                         (foreach a        lalst
    
50.                                 (if (equal (cdr enlst) (cdr a)) (setq lalst1  (cons a lalst1)))
    
51.                         );颜色线型相同的层，可能有多个
    
52.                         (if lalst1
    
53.                                 (command "chprop" ee "" "la" (car lalst1) "")
    
54.                                 (progn
    
55.                                         (setq Laname(strcat "色" (rtos co 2  0)"+线" lsty ))
    
56.                                         ;颜色+线型的图层名
    
57.                                         (If (= (Tblsearch "layer" Laname) nil)
    
58.                                                 (command "-layer"
    
59.                                                         "n" Laname
    
60.                                                         "c" co Laname
    
61.                                                         "l" lsty Laname ""
    
62.                                                 )                       
    
63.                                         );;;颜色+线型取名定义新图层
    
64.                                         (command "chprop" ee "" "la" Laname "")                                       
    
65.                                 )
    
66.                         )
    
67.                 )
    
68.         )
    
69.         (setq i (+ i 1))
    
70. )
    
71. )

;另一种，拿对象颜色 线型与已有层颜色 线型比较<br /> ;==========================<br /> ;取得已有层的属性表<br /> ;返回((层名1 颜色 线型)(层名2 颜色 线型)......)<br /> (defun getlalst ( / TBL TBL_LIST )<br /> (while (setq TBL (tblnext "LAYER" (null TBL))) <br />         (setq TBL_LIST <br />                 (cons <br />                         (list<br />                                 (cdr (assoc 2 TBL))<br />                                 (cdr (assoc 62 TBL))<br />                                 (cdr (assoc 6 TBL))<br />                         ) <br />                         TBL_LIST<br />                 )<br />         ) <br /> )<br /> )<br /> <br /> ;取得图元的图层+颜色+线型信息<br /> ;(getenpro (car(entsel)))<br /> ;返回(层名 颜色 线型)<br /> (defun getenpro (ee / obj pro1 pro2 pro3 pro4 pro5)              <br />         (setq obj (vlax-ename->vla-object ee)<br />              pro1 (vlax-get-property obj "Layer")<br />              pro2(vlax-get-property obj "Color")<br />              pro3(vlax-get-property obj "Linetype")<br />              pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色 <br />              pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型<br />     )<br />     (list  pro1 ;图层<br />             (if (equal pro2 256) pro4 pro2);图元颜色<br />             (if (equal pro3 "ByLayer") pro5 pro3);图元线型<br />     )<br /> )<br /> (defun c:newla1 ( / ss i ee lalst enlst co lsty lalst1 a Laname)<br /> (setq ss(ssget))<br /> (setq i 0)<br /> (while (setq ee (ssname ss i))             <br />         (setq lalst (getlalst) lalst1 nil)<br />         (setq enlst (getenpro ee)<br />                 co  (cadr enlst);图元颜色<br />                 lsty (caddr enlst);图元线型<br />         )<br />         (if (member enlst lalst )<br />                 nil<br />                 (progn<br />                         (foreach a        lalst<br />                                 (if (equal (cdr enlst) (cdr a)) (setq lalst1  (cons a lalst1)))<br />                         );颜色线型相同的层，可能有多个<br />                         (if lalst1 <br />                                 (command "chprop" ee "" "la" (car lalst1) "")<br />                                 (progn<br />                                         (setq Laname(strcat "色" (rtos co 2  0)"+线" lsty ))<br />                                         ;颜色+线型的图层名<br />                                         (If (= (Tblsearch "layer" Laname) nil)<br />                                                 (command "-layer" <br />                                                         "n" Laname <br />                                                         "c" co Laname <br />                                                         "l" lsty Laname ""<br />                                                 )                        <br />                                         );;;颜色+线型取名定义新图层<br />                                         (command "chprop" ee "" "la" Laname "")                                        <br />                                 )<br />                         )<br />                 )<br />         )<br />         (setq i (+ i 1))<br /> )<br /> )

wzg356

有循环的呀？选择集里面逐个判断。

本身你的逻辑有问题，如果已有层颜色+线型相同的有多个，难道要搞一个图层合并？拿不如用沙发楼的。

第一个（沙发）：类似于把已有层按颜色+线型更名，每刷一遍，选择的对象自动按对象颜色、线型归入相应的层。
第二个（楼上)：只按对象颜色、线型与已有层颜色+线型对比并归入相应层（如果颜色+线型相同的层有多个，只选一个放进去)，或按颜色、线型建新层并把相应图元放进去。

也就是第一个统一层名规则
第二个只管层的颜色+线型，新建层颜色+线型不会与已有层颜色+线型重复（已有的是否重复不管)，但新层名可能与已有层名重复就没考虑了，只是概率极小，可以用

尘缘一生

wzg356 发表于 2015-12-15 14:05
有循环的呀？选择集里面逐个判断。

本身你的逻辑有问题，如果已有层颜色+线型相同的有多个，难道要搞一个 ...

       假如2个实体，颜色与线型均相同，存在于已经存在得两个层上，我们不管它，为什么要管？有必要吗？因为他们的颜色与线型与层的定义同，没错！
    为了优化？归并层，当然好，因为归并层的代码早有了。
   
      我没有发现存在一个代码能把颜色和线型与所存在得层设置不同的，变对了它，因为，没有这个功能，任何代码，把实体按颜色分层的，都无有任何意义，试想以下：

     1:我一个实体，为LINE ,色为红色，线型为 实线，存在层 1上
     2:我还有一个实体，为LINE， 色为红色，线型为“轴线”，也存在层1上，这个实体不对，因为层1是存实线且红色的！

    就要把实体变对与层设置相符得去，不用管层最后是多少个，多又怎么样？嫌多，归并即可，有代码了，哪么，最基本的实体都变不过去，还归并个鸟？

wzg356

第二个还不行？

qianzj

光图层的话  cad的标准检查就可以吧

尘缘一生

wzg356 发表于 2015-12-15 16:53
第二个还不行？

我确实看不大懂,但从判断部分啥的，觉得很正确的，但我实验运行不了，变量说错误中断，我改了下循环条件，也不行。看运行信息啊，输入层名为“BYAYER”，然后就中断了。
    我CAD初始存在的层，线型都是随层的。

2. ;另一种，拿对象颜色 线型与已有层颜色 线型比较
   
3. ;==========================
   
4. ;取得已有层的属性表
   
5. ;返回((层名1 颜色 线型)(层名2 颜色 线型)......)
   
6. (defun getlalst ( / TBL TBL_LIST )
   
7. (while (setq TBL (tblnext "LAYER" (null TBL)))
   
8.         (setq TBL_LIST
   
9.                 (cons
   
10.                         (list
    
11.                                 (cdr (assoc 2 TBL))
    
12.                                 (cdr (assoc 62 TBL))
    
13.                                 (cdr (assoc 6 TBL))
    
14.                         )
    
15.                         TBL_LIST
    
16.                 )
    
17.         )
    
18. )
    
19. )
    
20. 
    
21. ;取得图元的图层+颜色+线型信息
    
22. ;(getenpro (car(entsel)))
    
23. ;返回(层名 颜色 线型)
    
24. (defun getenpro (ee / obj pro1 pro2 pro3 pro4 pro5)              
    
25.         (setq obj (vlax-ename->vla-object ee)
    
26.              pro1 (vlax-get-property obj "Layer")
    
27.              pro2(vlax-get-property obj "Color")
    
28.              pro3(vlax-get-property obj "Linetype")
    
29.              pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色
    
30.              pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型
    
31.     )
    
32.     (list  pro1 ;图层
    
33.             (if (equal pro2 256) pro4 pro2);图元颜色
    
34.             (if (equal pro3 "ByLayer") pro5 pro3);图元线型
    
35.     )
    
36. )
    
37. (defun c:newla1 ( / ss i ee lalst enlst co lsty lalst1 a Laname)
    
38. (setq ss(ssget))
    
39. (setq n (sslength ss))
    
40. (setq i 0)
    
41. (while (< i n)
    
42.         (setq ee (ssname ss i))            
    
43.         (setq lalst (getlalst) lalst1 nil)
    
44.         (setq enlst (getenpro ee)
    
45.                 co  (cadr enlst);图元颜色
    
46.                 lsty (caddr enlst);图元线型
    
47.         )
    
48.         (if (member enlst lalst )
    
49.                 nil
    
50.                 (progn
    
51.                         (foreach a        lalst
    
52.                                 (if (equal (cdr enlst) (cdr a)) (setq lalst1  (cons a lalst1)))
    
53.                         );颜色线型相同的层，可能有多个
    
54.                         (if lalst1
    
55.                                 (command "chprop" ee "" "la" (car lalst1) "")
    
56.                                 (progn
    
57.                                         (setq Laname(strcat "色" (rtos co 2  0)"+线" lsty ))
    
58.                                         ;颜色+线型的图层名
    
59.                                         (If (= (Tblsearch "layer" Laname) nil)
    
60.                                                 (command "-layer"
    
61.                                                         "n" Laname
    
62.                                                         "c" co Laname
    
63.                                                         "l" lsty Laname ""
    
64.                                                 )                        
    
65.                                         );;;颜色+线型取名定义新图层
    
66.                                         (command "chprop" ee "" "la" Laname "")                                       
    
67.                                 )
    
68.                         )
    
69.                 )
    
70.         )
    
71.         (setq i (+ i 1))
    
72. )
    
73. )
    

;另一种，拿对象颜色 线型与已有层颜色 线型比较<br /> ;==========================<br /> ;取得已有层的属性表<br /> ;返回((层名1 颜色 线型)(层名2 颜色 线型)......)<br /> (defun getlalst ( / TBL TBL_LIST )<br /> (while (setq TBL (tblnext "LAYER" (null TBL))) <br />         (setq TBL_LIST <br />                 (cons <br />                         (list<br />                                 (cdr (assoc 2 TBL))<br />                                 (cdr (assoc 62 TBL))<br />                                 (cdr (assoc 6 TBL))<br />                         ) <br />                         TBL_LIST<br />                 )<br />         ) <br /> )<br /> )<br /> <br /> ;取得图元的图层+颜色+线型信息<br /> ;(getenpro (car(entsel)))<br /> ;返回(层名 颜色 线型)<br /> (defun getenpro (ee / obj pro1 pro2 pro3 pro4 pro5)              <br />         (setq obj (vlax-ename->vla-object ee)<br />              pro1 (vlax-get-property obj "Layer")<br />              pro2(vlax-get-property obj "Color")<br />              pro3(vlax-get-property obj "Linetype")<br />              pro4(cdr (assoc 62 (tblsearch "LAYER" pro1)));;图元现在层颜色 <br />              pro5(cdr (assoc 6 (tblsearch "LAYER" pro1)));;图元现在层线型<br />     )<br />     (list  pro1 ;图层<br />             (if (equal pro2 256) pro4 pro2);图元颜色<br />             (if (equal pro3 "ByLayer") pro5 pro3);图元线型<br />     )<br /> )<br /> (defun c:newla1 ( / ss i ee lalst enlst co lsty lalst1 a Laname)<br /> (setq ss(ssget))<br /> (setq n (sslength ss))<br /> (setq i 0)<br /> (while (< i n)<br />         (setq ee (ssname ss i))             <br />         (setq lalst (getlalst) lalst1 nil)<br />         (setq enlst (getenpro ee)<br />                 co  (cadr enlst);图元颜色<br />                 lsty (caddr enlst);图元线型<br />         )<br />         (if (member enlst lalst )<br />                 nil<br />                 (progn<br />                         (foreach a        lalst<br />                                 (if (equal (cdr enlst) (cdr a)) (setq lalst1  (cons a lalst1)))<br />                         );颜色线型相同的层，可能有多个<br />                         (if lalst1 <br />                                 (command "chprop" ee "" "la" (car lalst1) "")<br />                                 (progn<br />                                         (setq Laname(strcat "色" (rtos co 2  0)"+线" lsty ))<br />                                         ;颜色+线型的图层名<br />                                         (If (= (Tblsearch "layer" Laname) nil)<br />                                                 (command "-layer" <br />                                                         "n" Laname <br />                                                         "c" co Laname <br />                                                         "l" lsty Laname ""<br />                                                 )                        <br />                                         );;;颜色+线型取名定义新图层<br />                                         (command "chprop" ee "" "la" Laname "")                                        <br />                                 )<br />                         )<br />                 )<br />         )<br />         (setq i (+ i 1))<br /> )<br /> )<br />

尘缘一生

尘缘一生 发表于 2015-12-15 16:38
假如2个实体，颜色与线型均相同，存在于已经存在得两个层上，我们不管它，为什么要管？有必要吗？ ...

没法用图表示，我有一红色实体线，和一红色轴线，用哪个按色分层（一楼我发的代码），它却生成个新层，把这2个实体都收进去，却同时变成了实线，大错特错。