指定一个LAYOUT名字并激活它

Lisphk

1. (vl-load-com)
   
2. (defun currtab (lname / adoc acapp)
   
3.   (or
   
4.     acapp
   
5.     (setq acapp (vlax-get-acad-object))
   
6.   )
   
7.   (or
   
8.     adoc
   
9.     (setq adoc (vla-get-activedocument acapp))
   
10.   )
    
11.   (if (not (vl-catch-all-error-p (setq res (vl-catch-all-apply
    
12.                                                                (function
    
13.                                                                          (lambda
    
14.                                                                            ()
    
15.                                                                            (vla-item
    
16.                                                                                      (vla-get-layouts adoc) lname
    
17.                                                                            )
    
18.                                                                          )
    
19.                                                                )
    
20.                                            )
    
21.                                  )
    
22.            )
    
23.       )
    
24.     (progn
    
25.       (vla-put-activelayout adoc (vla-item (vla-get-layouts adoc) lname))
    
26.       t
    
27.     )
    
28.     nil
    
29.   )
    
30. )
    
31. 
    
32. 
    
33. ;; Usage
    
34. (defun c:tt (/ lname)                       
    
35.   (if (/= "" (setq lname (getstring t "\nEnter layout name you want to set current: ")))
    
36.     (if (not (currtab lname))
    
37.       (alert "Layout does not exist")
    
38.     )
    
39.   )
    
40.   (princ)
    
41. )
    

(vl-load-com)<br /> (defun currtab (lname / adoc acapp)<br />   (or<br />     acapp<br />     (setq acapp (vlax-get-acad-object))<br />   )<br />   (or<br />     adoc<br />     (setq adoc (vla-get-activedocument acapp))<br />   )<br />   (if (not (vl-catch-all-error-p (setq res (vl-catch-all-apply<br />                                                                (function<br />                                                                          (lambda<br />                                                                            ()<br />                                                                            (vla-item<br />                                                                                      (vla-get-layouts adoc) lname<br />                                                                            )<br />                                                                          )<br />                                                                )<br />                                            )<br />                                  )<br />            )<br />       )<br />     (progn<br />       (vla-put-activelayout adoc (vla-item (vla-get-layouts adoc) lname))<br />       t<br />     )<br />     nil<br />   )<br /> )<br /> <br /> <br /> ;; Usage<br /> (defun c:tt (/ lname)                       <br />   (if (/= "" (setq lname (getstring t "\nEnter layout name you want to set current: ")))<br />     (if (not (currtab lname))<br />       (alert "Layout does not exist")<br />     )<br />   )<br />   (princ)<br /> )<br />

下面代码，按空格，循环激活每个LAYOUT

1. (defun c:tt (/ adoc)
   
2.   (vl-load-com)
   
3.   (setvar "TILEMODE" 1)
   
4.   (vlax-for l (vla-get-layouts (setq adoc (vla-get-activedocument
   
5.                                                                   (vlax-get-acad-object)
   
6.                                           )
   
7.                                )
   
8.               ) (getkword (strcat "\nPress Spacebar for layout '"
   
9.                                   (vla-get-name l) "' "
   
10.                           )
    
11.                 ) (vla-put-activelayout adoc l)
    
12.   )                                       ; end vlax-for
    
13.   (princ "\n<<< No more layouts, goodbuy... >>> ")
    
14.   (princ)
    
15. )
    

(defun c:tt (/ adoc)<br />   (vl-load-com)<br />   (setvar "TILEMODE" 1)<br />   (vlax-for l (vla-get-layouts (setq adoc (vla-get-activedocument<br />                                                                   (vlax-get-acad-object)<br />                                           )<br />                                )<br />               ) (getkword (strcat "\nPress Spacebar for layout '"<br />                                   (vla-get-name l) "' "<br />                           )<br />                 ) (vla-put-activelayout adoc l)<br />   )                                       ; end vlax-for<br />   (princ "\n<<< No more layouts, goodbuy... >>> ")<br />   (princ)<br /> )<br />

xvjiex

感谢分享指定一个LAYOUT名字并激活它