求lisp代码！怎么把图层改成与文字内容一样名称的图层

代码如下：

(defun c:tes ( / &kw ent i lays n obj tc tr x)

(vl-load-com)

(princ "\n请选择文字")

(if (setq &kw (ssget '((0 . "TEXT"))))

(progn

(while (setq ent (ssname &kw 0))

(setq &kw (ssdel ent &kw)

obj (vlax-ename->vla-object ent)

tr (cdr (assoc 1 (entget ent)))文字内容

n (vla-get-color obj)颜色

x (vla-get-Lineweight obj)线宽

i (vla-get-Linetype obj)线型

tc (vla-get-layer obj)图层

lays (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) tc)图层

)

(if (= n 256) (setq n (vla-get-color lays)))

(if (= n 0) (setq n 7) )图层颜色修正

(if (= i "ByLayer") (setq i (vla-get-Linetype lays)) )

(if (= i "ByBlock") (setq i "Continuous") )线型修正

(if (member x '(-1 -2)) (setq x (vla-get-Lineweight lays)) )

(xtc1 i n tr x)检查图层

(vla-put-layer obj tr)修改图层

)

)

)

(princ)

)

(defun xtc1 (i n r x / i n r x)

(if (null (tblsearch "layer" r))

(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 6 i) (cons 62 n) (cons 370 x) '(70 . 0) '(290 . 1) (cons 2 r)))

)

)

复制以上代码，粘贴到记事本，以【.lsp】为后缀，保存的编码格式为【ANSI】，CAD加载后，输入命令【TES】，选择文字就可以建立新图层。

(if (null (tblsearch "layer" "图层名称"))

 (entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord") '(6 . "Center") '(62 . 1) '(370 . 0) '(70 . 0) '(290 . 1) '(2 . "图层名称")))

 6组码【线型】,62组码【颜色】,370组码【线宽】,70组码【可见】,290组码【打印】，2组码【图层名称】

 )autolisp建立图层

打开指定图层lisp

(defun c:tes ( / lay lays obj TC_ss tc1)

(vl-load-com)

(setq TC_ss '() lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))

(vlax-for obj lays

(setq TC_ss (cons (vla-get-Name obj) TC_ss))提取所有图层

)

(setq TC_ss (mapcar 'strcase TC_ss) lay nil)

(if tc_mc

(if (and (setq tc1 (getstring (strcat "\n请输入需要打开的图层名称默认:<" tc_mc ">"))) (/= tc1 ""))

(setq tc_mc (strcase tc1) lay t)

(setq lay t)

)

(if (setq tc1 (getstring "\n请输入需要打开的图层名称:")) (setq tc_mc (strcase tc1) lay t) )

)

(if lay

(progn

(if (member tc_mc TC_ss)

(progn

(setq lay (vla-add lays tc_mc))

(if (<(cdr (assoc 62 (tblsearch "layer" tc_mc))) 0) (vla-put-LayerOn lay :vlax-true))打开

)

(progn

(princ (strcat "\n没有(" tc_mc ")这个图层，仔细核对后输入"))

(setq tc_mc nil)

)

)

)

)

(princ)

)

以上是autolisp程序

---