[编程申请]：编缉线的图层

wuwangwo48

不知有没有这样的一个命令：
请选择要改变的线(最好是什么线都可以）*-*6 ：
回车OK
结果选择的线就自己归到中心线的那个图层去了，如果没有这个图层就自动建立一个*-*6
注：只要改成中心线即可：）（专类专用嘛，加快速度）

lsjjm

Reference:

2. 
   
3. (defun c:test ()
   
4.   (vl-load-com)
   
5.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   
6.   (setq ent (entsel "\nSelect object on layer to copy from: "))
   
7.   (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))
   
8.   (cond
   
9.     ((setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,"))))
   
10.       (setq i 0)
    
11.       (vla-StartUndoMark doc)
    
12.       (repeat (sslength ss)
    
13.         (vla-put-layer (vlax-ename->vla-object (ssname ss i)) lay)
    
14.         (setq i (1+ i))
    
15.       )
    
16.       (vla-EndUndoMark adoc))
    
17.   )
    
18.   (vlax-release-object adoc)
    
19.   (princ)
    
20. )

<br /> (defun c:test ()<br />   (vl-load-com)<br />   (setq doc (vla-get-activedocument (vlax-get-acad-object)))<br />   (setq ent (entsel "\nSelect object on layer to copy from: "))<br />   (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))<br />   (cond<br />     ((setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,"))))<br />       (setq i 0)<br />       (vla-StartUndoMark doc)<br />       (repeat (sslength ss)<br />         (vla-put-layer (vlax-ename->vla-object (ssname ss i)) lay)<br />         (setq i (1+ i))<br />       )<br />       (vla-EndUndoMark adoc))<br />   )<br />   (vlax-release-object adoc)<br />   (princ)<br /> )

wuwangwo48

*-*4 谢谢！懒汉还需好心人帮！
不过好像只是提取对象的属性，然后改变对象的图层，并没有自动建立一个图层的功能啊而且这个图层层名是“中心线”线形是“中心线”颜色是红色*-*3

lsjjm

2. (defun mlayer (name color ltype)
   
3.   (if (tblsearch "layer" name)
   
4.       (vl-cmdf "layer" "s" name "")
   
5.       (progn
   
6.         (setq regen (getvar "regenmode"))
   
7.         (setvar "regenmode" 0)
   
8.         (vl-cmdf "layer" "m" name)
   
9.         (if color (vl-cmdf "c" color name))
   
10.         (if ltype (vl-cmdf "lt" ltype name))
    
11.         (vl-cmdf "")
    
12.         (setvar "regenmode" regen)
    
13.       );p
    
14.   );i
    
15. );
    
16. ;;

(defun mlayer (name color ltype)<br />   (if (tblsearch "layer" name)<br />       (vl-cmdf "layer" "s" name "")<br />       (progn<br />         (setq regen (getvar "regenmode"))<br />         (setvar "regenmode" 0)<br />         (vl-cmdf "layer" "m" name)<br />         (if color (vl-cmdf "c" color name))<br />         (if ltype (vl-cmdf "lt" ltype name))<br />         (vl-cmdf "")<br />         (setvar "regenmode" regen)<br />       );p<br />   );i<br /> );<br /> ;;

wuwangwo48

*-*8  我比较笨不会用*-*8

lsjjm

要是临时或不常用, 在命令行加载:
(load "yourfile.lsp") --c:test所在 lisp 文件.
然后运行: 键入: TEST即可
如果经常用, 可将其复制到ACAD.LSP文件中或用MNS菜单文件自动加载.