[转贴]：改变图层层名的VLISP程序

lsjjm

改变图层层名的VLISP程序

2. 
   
3. ;;; renames an existing layer. returns nothing
   
4. ;;; ARGUMENTS
   
5. ;;; current-name = string (existing layer name)
   
6. ;;; new-name = string (new name for existing layer)
   
7. ;;; USAGE
   
8. ;;; to re-name a layer use (MST-LayerReName "fred" "barney")
   
9. ;;; were "fred" is the current layer name and "barney" is
   
10. ;;; new name
    
11. ;;;
    
12. ;;; PLATFORMS 2000+
    
13. ;;;
    
14. ;;; AUTHOR
    
15. ;;; Copyright© 2003 Mark S. Thomas
    
16. ;;; [email]mark.thomas@theswamp.org[/email]
    
17. ;;;
    
18. ;;; VERSION
    
19. ;;; 1.0 Fri Oct 10, 2003
    
20. (defun MST-LayerReName (current-name new-name / laysobj re-named-layer)
    
21.   (if
    
22.     (and (= (type current-name) (type new-name) 'STR))
    
23.     (progn
    
24.       (setq laysobj
    
25.             (vla-get-Layers
    
26.               (vla-get-ActiveDocument (vlax-get-acad-object))
    
27.               )
    
28.             ); setq
    
29.       (if
    
30.         (not
    
31.           (vl-catch-all-error-p
    
32.             (setq re-named-layer
    
33.                   (vl-catch-all-apply
    
34.                     'vlax-invoke-method
    
35.                     (list laysobj 'Item current-name)
    
36.                     )
    
37.                   ); setq
    
38.             )
    
39.           );  not
    
40.         (progn
    
41.           (vlax-put-property re-named-layer 'Name new-name)
    
42.           (vlax-release-object re-named-layer)
    
43.           )
    
44.         ); if
    
45.       (vlax-release-object laysobj)
    
46.       ); progn
    
47.     ); if
    
48.   (princ)
    
49.   ); defun

<br /> ;;; renames an existing layer. returns nothing <br /> ;;; ARGUMENTS <br /> ;;; current-name = string (existing layer name) <br /> ;;; new-name = string (new name for existing layer) <br /> ;;; USAGE <br /> ;;; to re-name a layer use (MST-LayerReName "fred" "barney") <br /> ;;; were "fred" is the current layer name and "barney" is <br /> ;;; new name <br /> ;;; <br /> ;;; PLATFORMS 2000+ <br /> ;;; <br /> ;;; AUTHOR <br /> ;;; Copyright&copy; 2003 Mark S. Thomas <br /> ;;; [email]mark.thomas@theswamp.org[/email] <br /> ;;; <br /> ;;; VERSION <br /> ;;; 1.0 Fri Oct 10, 2003 <br /> (defun MST-LayerReName (current-name new-name / laysobj re-named-layer) <br />   (if <br />     (and (= (type current-name) (type new-name) 'STR)) <br />     (progn <br />       (setq laysobj <br />             (vla-get-Layers <br />               (vla-get-ActiveDocument (vlax-get-acad-object)) <br />               ) <br />             ); setq <br />       (if <br />         (not <br />           (vl-catch-all-error-p <br />             (setq re-named-layer <br />                   (vl-catch-all-apply <br />                     'vlax-invoke-method <br />                     (list laysobj 'Item current-name) <br />                     ) <br />                   ); setq <br />             ) <br />           );  not <br />         (progn <br />           (vlax-put-property re-named-layer 'Name new-name) <br />           (vlax-release-object re-named-layer) <br />           ) <br />         ); if <br />       (vlax-release-object laysobj) <br />       ); progn <br />     ); if <br />   (princ) <br />   ); defun

luoyaya

用COMMAND调用REN不是很快吗?

lsjjm

那是"手工"操作, 原贴功能是用于程序中.

ydf7332462

谢了，另一栏(该栏现不能进入）的问题已解决。现进一步-----copy到附加 前缀层：
回车->$层; `->~; 3-># ; 4->$; 5->%; 6-> ^ ; 7->&; 8->*; =->+
并使copy后的z=0