[编程申请]：点选将例如COLUMN图层变成1COLUMN图层

dhxf

需要整理的图层较多；修改图层前缀可调，默认为1；
另一个命令修改图层颜色；
翻遍没找到这样LSP；
用LAYER修改无效工作太多；
人懒，麻烦领导了

lsjjm

(defun c:test ()
  (setq ent (car (entsel)))
  (setq lay (cdr (assoc 8 (entget ent))))
  (vl-cmdf "rename" "la" lay (strcat "1" lay))
)

dhxf

帅~直接加1
得陇望蜀想前缀可以修改;
颜色也想实现偷懒
谢谢jm

lsjjm

修改图层颜色:
(defun c:test ()
  (setq ent (entsel "\nSelect entity to change color of layer: "))
  (setq lay (cdr (assoc 8 (entget (car ent)))))
  (setq getcolor (acad_colordlg 1))
  (command "-layer" "c" getcolor lay "")
)

dhxf

好好好－－－长老是长老；不错
特别喜欢这个颜色的修改；
图层加前缀的应用的时候修改了一下，增加前缀2；
对于改图功效不小；
谢～

心竹

谢谢长老，图层改名能不能增加选项功能？比如自己可以输入想要加入的前缀，或者直接将这个名字改为另外的名称。

lsjjm

最初由 心竹 发布
[B]谢谢长老，图层改名能不能增加选项功能？比如自己可以输入想要加入的前缀，或者直接将这个名字改为另外的名称。 [/B]

TRY THIS:
[php]
(defun c:test ()
  (setq ent (car (entsel "\nClick the layer to Change: ")))
  (initget "A C")
  (setq kw (getkword "\n[Addprefix/Changename]:"))
  (setq lay (cdr (assoc 8 (entget ent))))
  (cond
    ((= kw "A")
     (setq ln (getstring "Input Prefix: "))
     (vl-cmdf "rename" "la" lay (strcat ln lay)))
    ((= kw "C")
     (setq ln (getstring "Input New Name: "))
     (vl-cmdf "rename" "la" lay ln))
  )
)
[/php]

雪晴

谢谢长老，试用了一下你上面改变颜色的程序，弹出的对话框中显示的颜色都是红色，能不能改成显示所选层的颜色？这样的话又多了一个功能，可以方便的查询每个层的颜色。

梦断江南

加点东西：）

2. 
   
3. ;; chlan = 图层改名------------------梦断江南.2004.8
   
4. ;;参考 lsjjm程序.
   
5. (defun c:chlan ( / ent nam lay len fil)
   
6.   (setq ent (car (entsel "\n选层参照实体: "))
   
7.         lay (cdr (assoc 8 (entget ent))))
   
8.   (princ "\n所选实体层名:")(princ lay)
   
9.   (princ "\n加前缀输入－前缀*")
   
10.   (setq nam (getstring "\n新图层名:")
    
11.         len (strlen nam)
    
12.         fil (apply 'strcat (mapcar '(lambda(x)(strcat "," "*`" x "*"))(mapcar 'chr (vl-string->list "<>/";?*|,=\")))))
    
13.   (if (= "*" (substr nam len))
    
14.     (setq nam (strcat (substr nam 1 (1- (strlen nam))) lay))
    
15.   )
    
16.   (if (wcmatch nam (strcat "0,DEFPOINTS" fil));"<>/";?*|,="
    
17.       (princ "\n!图层名无效!")
    
18.       (progn
    
19.         (vl-cmdf "rename" "la" lay nam)
    
20.         (mapcar 'princ (list "\n旧层名: " lay "   已经改为新层名: " nam))
    
21.       )
    
22.   )(princ)
    
23. )
    

<br /> ;; chlan = 图层改名------------------梦断江南.2004.8<br /> ;;参考 lsjjm程序.<br /> (defun c:chlan ( / ent nam lay len fil) <br />   (setq ent (car (entsel "\n选层参照实体: "))<br />         lay (cdr (assoc 8 (entget ent))))<br />   (princ "\n所选实体层名:")(princ lay)<br />   (princ "\n加前缀输入－前缀*")<br />   (setq nam (getstring "\n新图层名:")<br />         len (strlen nam)<br />         fil (apply 'strcat (mapcar '(lambda(x)(strcat "," "*`" x "*"))(mapcar 'chr (vl-string->list "<>/";?*|,=\"))))) <br />   (if (= "*" (substr nam len))<br />     (setq nam (strcat (substr nam 1 (1- (strlen nam))) lay))<br />   )<br />   (if (wcmatch nam (strcat "0,DEFPOINTS" fil));"<>/";?*|,="<br />       (princ "\n!图层名无效!")<br />       (progn<br />         (vl-cmdf "rename" "la" lay nam)<br />         (mapcar 'princ (list "\n旧层名: " lay "   已经改为新层名: " nam))<br />       )<br />   )(princ)<br /> )<br />

测试：
命令: chlan

选层参照实体:
所选实体层名:平面图
加前缀输入－前缀*
新图层名:33-*

旧层名: 平面图   已经改为新层名: 33-平面图

命令:
CHLAN
选层参照实体:
所选实体层名:33-平面图
加前缀输入－前缀*
新图层名:555

旧层名: 33-平面图   已经改为新层名: 555

命令:
CHLAN
选层参照实体:
所选实体层名:555
加前缀输入－前缀*
新图层名:6*6

!图层名无效!

lsjjm

最初由 雪晴 发布
[B]谢谢长老，试用了一下你上面改变颜色的程序，弹出的对话框中显示的颜色都是红色，能不能改成显示所选层的颜色？这样的话又多了一个功能，可以方便的查询每个层的颜色。 [/B]

请参考:
[php]
(defun c:test ()
  ;(vl-load-com)
  (setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (setq ent (car (entsel "\nSelect entity to change color of layer: ")))
  (setq lay (vla-item lays (cdr (assoc 8 (entget ent)))))
  (setq col (vla-get-color lay))
  (setq getcolor (acad_colordlg col))
  (command "-layer" "c" getcolor lay "")
)
[/php]