[求助]快速改图层

鬼魔

哪位朋友抽空帮忙编下,以前用过类似的,现在找不着

必须先选择物体,按主键盘上数字1-0,就把物体归入对应图层里,归入时，颜色随层,其他不变

数字1-0分别定义10个图层名字,例如,1 图层名字为 外线 2图层名字为 中线 等等,

如无图层,则建立图层再归入,颜色默认为白,其他随层

sailorcwx

2. (defun C:CL(/ YH_LAYER YH_LAYERLIST YH_LAYERN YH_S)
3.   (setq YH_layerlist (list "layer0" "layer1" "layer2" "layer3" "layer4" "layer5" "layer6" "layer7" "layer8" "layer9")) ;图层列表
4.   (setq YH_S (ssget))
5.   (if YH_S
6.     (progn
7.     (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)))
8.     (initget "0 1 2 3 4 5 6 7 8 9")
9.     (setq YH_layern (getkword "\n输入图层序号:"))
10.     (if YH_layern
11.       (progn
12. (setq YH_layer (nth (atoi YH_layern) YH_layerlist))
13. (if (null (tblsearch "LAYER" YH_layer))
14.    (entmake (list
15.        '(0 . "LAYER")
16.        '(100 . "AcDbSymbolTableRecord")
17.        '(100 . "AcDbLayerTableRecord")
18.        (cons 2 YH_layer)          ;图层名称
19.        '(70 . 0)           ;图层状态
20.        (cons 62 7)                 ;图层颜色
21.        (cons 6 "bylayer")          ;图层线型
22.        )
23.      )
24.    )
25. (command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")
26. )
27.       )
28.     )
29.     )
30.   (princ)
31.   )

(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)   )

鬼魔

QQQ for sailorcwx ,程序做的不错

是否能做到不用输命令,先选择而后改

sailorcwx

这样子怎么样

(defun c:1 (/ YH_S)
  (if (null (tblsearch "LAYER" "layer1"))
    (entmake (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
        '( 2 . "layer1")          ;图层名称
        '(70 . 0)                 ;图层状态
        '(62 . 7)                 ;图层颜色
        '(6 . "bylayer")          ;图层线型
 )
      )
    )
  (setq YH_S (cadr (ssgetfirst)))
  (if YH_S
    (command "CHPROP" YH_S "" "la" "layer1" "c" "bylayer" "")
    )
  )

sailorcwx

批量生产

(defun YH_chlayer (YH_layer / YH_S)
  (if (null (tblsearch "LAYER" YH_layer))
    (entmake (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
        (cons 2 YH_layer)          ;图层名称
        '(70 . 0)                 ;图层状态
        '(62 . 7)                 ;图层颜色
        '(6 . "bylayer")          ;图层线型
 )
      )
    )
  (setq YH_S (cadr (ssgetfirst)))
  (if YH_S
    (command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")
    )
  (princ)
  )

(defun c:0 ()
  (YH_chlayer "layer0")
  )
(defun c:1 ()
  (YH_chlayer "layer1")
  )
(defun c:2 ()
  (YH_chlayer "layer2")
  )
(defun c:3 ()
  (YH_chlayer "layer3")
  )
(defun c:4 ()
  (YH_chlayer "layer4")
  )
(defun c:5 ()
  (YH_chlayer "layer5")
  )
(defun c:6 ()
  (YH_chlayer "layer6")
  )
(defun c:7 ()
  (YH_chlayer "layer7")
  )
(defun c:8 ()
  (YH_chlayer "layer8")
  )
(defun c:9 ()
  (YH_chlayer "layer9")
  )

鬼魔

测试了下,非常完美,再次感谢sailorcwx帮忙

鬼魔

能否在帮我改下

原本程序是如有先选择对象时，把对象归如指定层，如没就建立图层再归入；能否改下如果没先选择对象时，则新建图层并至为当前层（第2种情况是有了图层，也能满足至为当前层）。如果是有先选择对象时，就归入指定层，而不必将指定层至为当前层，颜色随层，其他按原来的

sailorcwx

(defun YH_chlayer (YH_layer / YH_S)
  (if (null (tblsearch "LAYER" YH_layer))
    (entmake (list
        '(0 . "LAYER")
        '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
        (cons 2 YH_layer)          ;图层名称
        '(70 . 0)                 ;图层状态
        '(62 . 7)                 ;图层颜色
        '(6 . "bylayer")          ;图层线型
 )
      )
    )
  (setq YH_S (cadr (ssgetfirst)))
  (if YH_S
    (command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")
    (setvar "clayer" YH_layer)
    )
  (princ)
  )

(defun c:0 ()
  (YH_chlayer "layer0")
  )
(defun c:1 ()
  (YH_chlayer "layer1")
  )
(defun c:2 ()
  (YH_chlayer "layer2")
  )
(defun c:3 ()
  (YH_chlayer "layer3")
  )
(defun c:4 ()
  (YH_chlayer "layer4")
  )
(defun c:5 ()
  (YH_chlayer "layer5")
  )
(defun c:6 ()
  (YH_chlayer "layer6")
  )
(defun c:7 ()
  (YH_chlayer "layer7")
  )
(defun c:8 ()
  (YH_chlayer "layer8")
  )
(defun c:9 ()
  (YH_chlayer "layer9")
  )

Eric991

感谢sailorcwx,这个lsp找了很久了，终于找到了，而且很好用，谢谢！

fqqc

能否再帮我改一下啦？

要求：改变后的图层其它属性也要跟着变，不只是颜色，像线型之类的都要变

谢谢！