[LISP程序]：找错误

fylinwater

(defun createlayer ( layname layCOL / LST  )
(if  (and  (= 'STR (type layname )) (= 'INT (type layCOL )) )
      (progn
      (setq olst ( list    ))
      (setq lst  (list '(0 . "LAYER") (cons '2 layname) '(70 . 0 ) (cons '62 layCOL)  '(6 . "CONTINUOUS")))

     (PRINT LST)
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (entmake lst)
    ) ;;end of progn

)
)
  为什么这个函数 无法建立新的层

ll_j

entmake符号表时必须有组码100项。这是我以前下载的程序，供参考：

2. 
   
3. ;;; This routine will create a layer with any name you type:
   
4.   (defun c:mlay ()        ; by Reinaldo Togores <rtogores@mundivia.es>
   
5.     (setq laynam (getstring "\nLayer name: "))
   
6.       (entmake
   
7.        (list
   
8.           '(0 . "LAYER")
   
9.           '(5 . "28")
   
10.           '(100 . "AcDbSymbolTableRecord")
    
11.           '(100 . "AcDbLayerTableRecord")
    
12.           (cons 2 laynam)
    
13.           '(70 . 64)
    
14.           '(62 . 7)
    
15.           '(6 . "CONTINUOUS")
    
16.       )))
    
17. 
    
18.   (defun c:msty()
    
19.     (setq stynam (getstring "\nStyle name: "))
    
20.       (entmake
    
21.        (list
    
22.          '(0 . "STYLE")
    
23.          '(5 . "28")
    
24.           '(100 . "AcDbSymbolTableRecord")
    
25.           '(100 . "AcDbTextStyleTableRecord")
    
26.          (cons 2  stynam)
    
27.          '(70 . 0)
    
28.          '(40 . 0.0)
    
29.          '(41 . 0.6)
    
30.          '(50 . 0.161799)
    
31.          '(71 . 0)
    
32.          '(42 . 3.0)
    
33.          '(3 . "romand.shx")
    
34.          '(4 . "tjhzf.shx")
    
35.      )))
    

<br /> ;;; This routine will create a layer with any name you type:<br />   (defun c:mlay ()        ; by Reinaldo Togores <rtogores@mundivia.es><br />     (setq laynam (getstring "\nLayer name: "))<br />       (entmake <br />        (list<br />           '(0 . "LAYER")<br />           '(5 . "28")<br />           '(100 . "AcDbSymbolTableRecord")<br />           '(100 . "AcDbLayerTableRecord")<br />           (cons 2 laynam)<br />           '(70 . 64)<br />           '(62 . 7)<br />           '(6 . "CONTINUOUS")<br />       )))<br /> <br />   (defun c:msty()<br />     (setq stynam (getstring "\nStyle name: "))<br />       (entmake<br />        (list<br />          '(0 . "STYLE")<br />          '(5 . "28")<br />           '(100 . "AcDbSymbolTableRecord")<br />           '(100 . "AcDbTextStyleTableRecord")<br />          (cons 2  stynam)<br />          '(70 . 0)<br />          '(40 . 0.0)<br />          '(41 . 0.6)<br />          '(50 . 0.161799)<br />          '(71 . 0)<br />          '(42 . 3.0)<br />          '(3 . "romand.shx")<br />          '(4 . "tjhzf.shx")<br />      )))<br />

fylinwater

谢谢
可是 TBLNEXT返回的表没有这一项的？
如果要修改一个层的名称 是不是也要加上 100？

ll_j

用AutoLisp构造符号表时组码100是必须的，将两行照搬即可。用Lisp进行层的修改，我也没办法，看Acad的帮助好像是可以得，但是我没有成功，在网上询问也无结果。

e2002

用ActiveX方法试试吧,很简单的

cy956

送你一个函数，连抄带改的。

2. [FONT=courier new]
   
3. 
   
4. (defun #m_Lay (LayName LayColor LayLineT / tList);;(#m_Lay "12" 1 "dashed")
   
5.   (if (setq tList(tblsearch "layer" LayName))(progn
   
6.     (setq LayColor0(dxf 62  tList)
   
7.           LayLineT0(dxf 6  tList))
   
8.     (if (and LayColor(/= LayColor LayColor0))
   
9.       (command "-layer" "c" LayColor LayName ""))
   
10.     (if (and LayLineT(/= LayLineT LayLineT0))
    
11.       (command "-layer" "lt" LayLineT LayName ""))
    
12.     )(progn
    
13.     (setq tList (list
    
14.                   '(0 . "LAYER")
    
15.                   '(100 . "AcDbSymbolTableRecord")
    
16.                   '(100 . "AcDbLayerTableRecord")
    
17.                   '(70 . 0)
    
18.                   (cons 2 LayName)
    
19.                 ))
    
20.     (if LayColor
    
21.       (setq tList (append tlist (list (cons 62 LayColor)))))
    
22.     (if LayLineT
    
23.       (setq tList (append tlist (list (cons 6 LayLineT)))) )
    
24.     (entmake tList)
    
25.   ) )
    
26. )
    
27. [/font]

[FONT=courier new]<br /> <br /> (defun #m_Lay (LayName LayColor LayLineT / tList);;(#m_Lay "12" 1 "dashed")<br />   (if (setq tList(tblsearch "layer" LayName))(progn<br />     (setq LayColor0(dxf 62  tList)<br />           LayLineT0(dxf 6  tList))<br />     (if (and LayColor(/= LayColor LayColor0))<br />       (command "-layer" "c" LayColor LayName ""))<br />     (if (and LayLineT(/= LayLineT LayLineT0))<br />       (command "-layer" "lt" LayLineT LayName ""))<br />     )(progn<br />     (setq tList (list<br />                   '(0 . "LAYER") <br />                   '(100 . "AcDbSymbolTableRecord") <br />                   '(100 . "AcDbLayerTableRecord") <br />                   '(70 . 0)<br />                   (cons 2 LayName)<br />                 ))<br />     (if LayColor<br />       (setq tList (append tlist (list (cons 62 LayColor))))) <br />     (if LayLineT<br />       (setq tList (append tlist (list (cons 6 LayLineT)))) )<br />     (entmake tList)<br />   ) )<br /> )<br /> [/font]

eachy

我在程序中这样用，改层名用rename命令就可以。

2. (setq old_lay (getvar "clayer"))
   
3. (if (=(tblobjname "LAYER" "3") nil)
   
4.     (progn
   
5.         (entmake (list
   
6.                     '(0 . "LAYER")
   
7.                     '(100 . "AcDbSymbolTableRecord")
   
8.                     '(100 . "AcDbLayerTableRecord")
   
9.                     '(6 . "CONTINUOUS")
   
10.                     '(62 . 3)
    
11.                     '(70 . 0)
    
12.                     (cons 2 "3")
    
13.                   )
    
14.         )
    
15.     )
    
16. )
    
17. (setvar "clayer" "3")

(setq old_lay (getvar "clayer"))<br /> (if (=(tblobjname "LAYER" "3") nil)<br />     (progn<br />         (entmake (list<br />                     '(0 . "LAYER")<br />                     '(100 . "AcDbSymbolTableRecord")<br />                     '(100 . "AcDbLayerTableRecord")<br />                     '(6 . "CONTINUOUS")<br />                     '(62 . 3)<br />                     '(70 . 0)<br />                     (cons 2 "3")<br />                   )<br />         )<br />     )<br /> )<br /> (setvar "clayer" "3")

长清

建立新的图层有几种办法：

1  用LAYER命令，不多说。
2  用ACTIVEX，但在R14中表现不稳定，不支持ACAD的多任务。
3  用ENTMAKE，这就是前面几位所说的建立新图层的办法，我推荐这种办法。但是，如果用TBLNEXT来索取DXF组码，信息不全，应该用TBLOBJNAME，用法如下：
(setq layer-0 (TBLOBJNAME "LAYER" "0"))
这是取得了0层的对象，数据DXF码为：
(setq dxf-layer-0 (entget layer-0))

((-1 . <Entity name: 2420478>) (0 . "LAYER") (5 . "F") (100 .
"AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "0") (70 . 0) (62
. 7) (6 . "CONTINUOUS"))

看见了，两个100呢，我们用SUBST 把（2 . “0”）改成 （2  . 新图层名字符串）就行了。以下是我使用的建立新图层的程序：

;;;--------------------------------------------;
;;;  图层生成 (makelayer layer color)
;;;  功能：生成一个图层并设置该图层为当前层
;;;        如果没有该图层，则生成，设为当前层
;;;        如果有,直接设为当前层
;;;  参数:
;;;         layer      字符串
;;;         color      整数
;;;           
;;;---------------------------------------
(defun makelayer (layer        color /        layer0 layer1 layer2 layer3 layer4
                  layer5)
  (if (not (setq layer0 (TBLOBJNAME "layer" layer)))
    (progn
      (setq layer0 (TBLOBJNAME "layer" "0"))
      (setq layer1 (entget layer0 '("*")))
      (setq layer2 (vl-remove (assoc -1 layer1) layer1))
      (setq layer3 (vl-remove (assoc 5 layer2) layer2))
      (setq layer4 (subst (cons 2 layer) (assoc 2 layer3) layer3))
      (setq layer5 (subst (cons 62 color) (assoc 62 layer4) layer4))
      (entmake layer5)
    )
    (progn
      (setq layer1 (entget layer0 '("*")))
      (setq layer2 (subst (cons 62 color) (assoc 62 layer1) layer1))
      (entmod layer2)
    )
  )
  (princ)
)
(vl-acad-defun 'makelayer)

以上程序用VLISPR14编写，在AUTOLISP中，不用VL-REMOVE，重新CONS有用元素就可以。如果不通过0层来传递，直接用
(entmake
  (cons 0  "LAYER")
  (cons 100 "AcDbSymbolTableRecord")
  (cons 100 "AcDbLayerTableRecord")
  (cons 2  图层名)
  (cons 70  0)
  (cosn 62 颜色号整数)
  (cons 6  "CONTINUOUS")
)

注意，线形最好不要指定，因为 .lin文件 不一定有你需要的线形呢，如果非要指定不可，应先加载。