[求助]快速改图层
本帖最后由 作者 于 2007-5-16 21:41:37 编辑 <br /><br /> <p>哪位朋友抽空帮忙编下,以前用过类似的,现在找不着</p><p>必须先选择物体,按主键盘上数字1-0,就把物体归入对应图层里,归入时，颜色随层,其他不变</p><p>数字1-0分别定义10个图层名字,例如,1 图层名字为 外线 2图层名字为 中线 等等,</p><p>如无图层,则建立图层再归入,颜色默认为白,其他随层</p> 本帖最后由 作者 于 2007-5-17 17:26:45 编辑(defun C:CL(/ YH_LAYER YH_LAYERLIST YH_LAYERN YH_S)
(setq YH_layerlist (list "layer0" "layer1" "layer2" "layer3" "layer4" "layer5" "layer6" "layer7" "layer8" "layer9")) ;图层列表
(setq YH_S (ssget))
(if YH_S
(progn
(princ (strcat "0-" (nth 0 YH_layerlist) " 1-" (nth 1 YH_layerlist) " 2-" (nth 2 YH_layerlist) " 3-" (nth 3 YH_layerlist) " 4-" (nth 4 YH_layerlist) "\n" " 5-" (nth 5 YH_layerlist) " 6-" (nth 6 YH_layerlist) " 7-" (nth 7 YH_layerlist) " 8-" (nth 8 YH_layerlist) " 9-" (nth 9 YH_layerlist)))
(initget "0 1 2 3 4 5 6 7 8 9")
(setq YH_layern (getkword "\n输入图层序号:"))
(if YH_layern
(progn
(setq YH_layer (nth (atoi YH_layern) YH_layerlist))
(if (null (tblsearch "LAYER" YH_layer))
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 YH_layer) ;图层名称
'(70 . 0) ;图层状态
(cons 62 7) ;图层颜色
(cons 6 "bylayer") ;图层线型
)
)
)
(command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")
)
)
)
)
(princ)
)
<p>QQQ for <font color="#000000"><strong>sailorcwx </strong>,</font>程序做的不错</p><p>是否能做到不用输命令,先选择而后改</p> <p>这样子怎么样</p><p>(defun c:1 (/ YH_S)<br/> (if (null (tblsearch "LAYER" "layer1"))<br/> (entmake (list<br/> '(0 . "LAYER")<br/> '(100 . "AcDbSymbolTableRecord")<br/> '(100 . "AcDbLayerTableRecord")<br/> '( 2 . "layer1") ;图层名称<br/> '(70 . 0) ;图层状态<br/> '(62 . 7) ;图层颜色<br/> '(6 . "bylayer") ;图层线型<br/> )<br/> )<br/> )<br/> (setq YH_S (cadr (ssgetfirst)))<br/> (if YH_S<br/> (command "CHPROP" YH_S "" "la" "layer1" "c" "bylayer" "")<br/> )<br/> )</p> <p>批量生产</p><p>(defun YH_chlayer (YH_layer / YH_S)<br/> (if (null (tblsearch "LAYER" YH_layer))<br/> (entmake (list<br/> '(0 . "LAYER")<br/> '(100 . "AcDbSymbolTableRecord")<br/> '(100 . "AcDbLayerTableRecord")<br/> (cons 2 YH_layer) ;图层名称<br/> '(70 . 0) ;图层状态<br/> '(62 . 7) ;图层颜色<br/> '(6 . "bylayer") ;图层线型<br/> )<br/> )<br/> )<br/> (setq YH_S (cadr (ssgetfirst)))<br/> (if YH_S<br/> (command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")<br/> )<br/> (princ)<br/> )</p><p>(defun c:0 ()<br/> (YH_chlayer "layer0")<br/> )<br/>(defun c:1 ()<br/> (YH_chlayer "layer1")<br/> )<br/>(defun c:2 ()<br/> (YH_chlayer "layer2")<br/> )<br/>(defun c:3 ()<br/> (YH_chlayer "layer3")<br/> )<br/>(defun c:4 ()<br/> (YH_chlayer "layer4")<br/> )<br/>(defun c:5 ()<br/> (YH_chlayer "layer5")<br/> )<br/>(defun c:6 ()<br/> (YH_chlayer "layer6")<br/> )<br/>(defun c:7 ()<br/> (YH_chlayer "layer7")<br/> )<br/>(defun c:8 ()<br/> (YH_chlayer "layer8")<br/> )<br/>(defun c:9 ()<br/> (YH_chlayer "layer9")<br/> )</p> 测试了下,非常完美,再次感谢<strong>sailorcwx</strong>帮忙 本帖最后由 作者 于 2007-6-3 13:57:14 编辑 <br /><br /> <p>能否在帮我改下</p><p>原本程序是如有先选择对象时，把对象归如指定层，如没就建立图层再归入；能否改下如果没先选择对象时，则新建图层并至为当前层（第2种情况是有了图层，也能满足至为当前层）。如果是有先选择对象时，就归入指定层，而不必将指定层至为当前层，颜色随层，其他按原来的</p> <p>(defun YH_chlayer (YH_layer / YH_S)<br/> (if (null (tblsearch "LAYER" YH_layer))<br/> (entmake (list<br/> '(0 . "LAYER")<br/> '(100 . "AcDbSymbolTableRecord")<br/> '(100 . "AcDbLayerTableRecord")<br/> (cons 2 YH_layer) ;图层名称<br/> '(70 . 0) ;图层状态<br/> '(62 . 7) ;图层颜色<br/> '(6 . "bylayer") ;图层线型<br/> )<br/> )<br/> )<br/> (setq YH_S (cadr (ssgetfirst)))<br/> (if YH_S<br/> (command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")<br/> <font color="#dd0000">(setvar "clayer" YH_layer)</font><br/> )<br/> (princ)<br/> )</p><p>(defun c:0 ()<br/> (YH_chlayer "layer0")<br/> )<br/>(defun c:1 ()<br/> (YH_chlayer "layer1")<br/> )<br/>(defun c:2 ()<br/> (YH_chlayer "layer2")<br/> )<br/>(defun c:3 ()<br/> (YH_chlayer "layer3")<br/> )<br/>(defun c:4 ()<br/> (YH_chlayer "layer4")<br/> )<br/>(defun c:5 ()<br/> (YH_chlayer "layer5")<br/> )<br/>(defun c:6 ()<br/> (YH_chlayer "layer6")<br/> )<br/>(defun c:7 ()<br/> (YH_chlayer "layer7")<br/> )<br/>(defun c:8 ()<br/> (YH_chlayer "layer8")<br/> )<br/>(defun c:9 ()<br/> (YH_chlayer "layer9")<br/> )</p> <p>感谢<strong><font face="Verdana" color="#61b713">sailorcwx,这个lsp找了很久了，终于找到了，而且很好用，谢谢！</font></strong></p> <p>能否再帮我改一下啦？</p><p>要求：改变后的图层其它属性也要跟着变，不只是颜色，像线型之类的都要变</p><p>谢谢！</p>
页:
[1]