[LISP程序]：把图纸视埠设为1xp

LUCAS

2. 
   
3. ;;;把图纸视埠设为1xp;;;
   
4. ;;; 程序设计:赖云龙 ;;;
   
5. ;;;-----------------;;;
   
6. (defun C:1XP        (/          HOLDECHO HOLDBLIP ORIG_OSNAP
   
7.                  ORIG_UCSFOLLOW           A            AL             A0              W
   
8.                  WDXF               W69      W410
   
9.                  R15            CH          XP
   
10.                 )
    
11.   (command "_.undo" "_group")
    
12.   (setq HOLDECHO (getvar "cmdecho"))
    
13.   (setq HOLDBLIP (getvar "blipmode"))
    
14.   (setq ORIG_OSNAP (getvar "osmode"))
    
15.   (setq ORIG_UCSFOLLOW (getvar "ucsfollow"))
    
16.   (setvar "cmdecho" 0)
    
17.   (setvar "blipmode" 0)
    
18.   (setvar "osmode" 0)
    
19.   (setvar "ucsfollow" 0)
    
20.   (setvar "tilemode" 0)
    
21.   (command "_.PSPACE")
    
22.   (setq        CH (getstring
    
23.              "\n所有视埠改为1XP(A)/<选择视埠改为1XP>: "
    
24.            )
    
25.   )
    
26.   (if (= CH "")
    
27.     (setq A (ssget '((0 . "VIEWPORT"))))
    
28.     (setq A (ssget "x" (list (cons 0 "VIEWPORT"))))
    
29.   )
    
30.   (setq AL (sslength A))
    
31.   (setq A0 0)
    
32.   (repeat AL
    
33.     (command "_.PSPACE")
    
34.     (setq W (ssname A (- AL 1)))
    
35.     (setq WDXF (entget W))
    
36.     (setq W69 (cdr (assoc 69 WDXF)))
    
37.     (if        (wcmatch (getvar "acadver") "15*")
    
38.       (progn
    
39.         (setq W410 (cdr (assoc 410 WDXF)))
    
40.         (setq R15 (getvar "ctab"))
    
41.       )
    
42.       (setq W410 R15)
    
43.     )
    
44.     (if        (and (/= W69 1) (/= W69 0) (= W410 R15))
    
45.       (progn
    
46.         (command "_.MSPACE")
    
47.         (command "_.cvport" W69)
    
48.         (COMMAND "_.ZOOM" "1XP")
    
49.       )
    
50.     )       
    
51.     (setq AL (- AL 1))
    
52.   )
    
53.   (command "_.pspace")
    
54.   (setvar "blipmode" HOLDBLIP)
    
55.   (setvar "osmode" ORIG_OSNAP)
    
56.   (setvar "ucsfollow" ORIG_UCSFOLLOW)
    
57.   (setvar "cmdecho" HOLDECHO)
    
58.   (command "_.undo" "_end")
    
59.   (princ)
    
60. )
    

<br /> ;;;把图纸视埠设为1xp;;;<br /> ;;; 程序设计:赖云龙 ;;;<br /> ;;;-----------------;;;<br /> (defun C:1XP        (/          HOLDECHO HOLDBLIP ORIG_OSNAP<br />                  ORIG_UCSFOLLOW           A            AL             A0              W<br />                  WDXF               W69      W410<br />                  R15            CH          XP<br />                 )<br />   (command "_.undo" "_group")<br />   (setq HOLDECHO (getvar "cmdecho"))<br />   (setq HOLDBLIP (getvar "blipmode"))<br />   (setq ORIG_OSNAP (getvar "osmode"))<br />   (setq ORIG_UCSFOLLOW (getvar "ucsfollow"))<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setvar "osmode" 0)<br />   (setvar "ucsfollow" 0)<br />   (setvar "tilemode" 0)<br />   (command "_.PSPACE")<br />   (setq        CH (getstring<br />              "\n所有视埠改为1XP(A)/<选择视埠改为1XP>: "<br />            )<br />   )<br />   (if (= CH "")<br />     (setq A (ssget '((0 . "VIEWPORT"))))<br />     (setq A (ssget "x" (list (cons 0 "VIEWPORT"))))<br />   )<br />   (setq AL (sslength A))<br />   (setq A0 0)<br />   (repeat AL<br />     (command "_.PSPACE")<br />     (setq W (ssname A (- AL 1)))<br />     (setq WDXF (entget W))<br />     (setq W69 (cdr (assoc 69 WDXF)))<br />     (if        (wcmatch (getvar "acadver") "15*")<br />       (progn<br />         (setq W410 (cdr (assoc 410 WDXF)))<br />         (setq R15 (getvar "ctab"))<br />       )<br />       (setq W410 R15)<br />     )<br />     (if        (and (/= W69 1) (/= W69 0) (= W410 R15))<br />       (progn<br />         (command "_.MSPACE")<br />         (command "_.cvport" W69)<br />         (COMMAND "_.ZOOM" "1XP")<br />       )<br />     )        <br />     (setq AL (- AL 1))<br />   )<br />   (command "_.pspace")<br />   (setvar "blipmode" HOLDBLIP)<br />   (setvar "osmode" ORIG_OSNAP)<br />   (setvar "ucsfollow" ORIG_UCSFOLLOW)<br />   (setvar "cmdecho" HOLDECHO)<br />   (command "_.undo" "_end")<br />   (princ)<br /> )<br />

li809

图纸视埠是什么