ActiveX UCS 保存与恢复

Free-Lancer

1. ;;命名保存当前 UCS
   
2. (defun fy:saveucs (name)
   
3.   (if (and name (not (tblsearch "ucs" name)))
   
4.     (vla-add (fy:acucss)
   
5.              (vlax-3d-point (getvar "ucsorg"))
   
6.              (vlax-3d-point (getvar "ucsxdir"))
   
7.              (vlax-3d-point (getvar "ucsydir"))
   
8.              name
   
9.     )
   
10.   )
    
11. )
    
12. ;;删除命名 UCS
    
13. (defun fy:delucs (nlst)
    
14.   (if (= (type nlst) 'STR)
    
15.     (setq nlst (list nlst))
    
16.   )
    
17.   (mapcar '(lambda (x)
    
18.              (if (tblsearch "ucs" x)
    
19.                (vla-delete (vla-item (fy:acucs) x))
    
20.              )
    
21.            )
    
22.           nlst
    
23.   )
    
24. )
    
25. ;;相当于 command ucs w ，可以放入 begin
    
26. (defun fy:setwcs ()
    
27.   (if (zerop (getvar "worlducs"))
    
28.     (progn
    
29.       (fy:saveucs "$fytempucs")
    
30.       (vla-put-activeucs
    
31.         (fy:acdoc)
    
32.         (vla-add (fy:acucss)
    
33.                  (vlax-3d-point '(0 0 0))
    
34.                  (vlax-3d-point '(1 0 0))
    
35.                  (vlax-3d-point '(0 1 0))
    
36.                  "$fytempwcs"
    
37.         )
    
38.       )
    
39.     )
    
40.   )
    
41. )
    
42. ;;恢复 UCS, 可以放入 end
    
43. (defun fy:restoreucs ()
    
44.   (if (tblsearch "ucs" $fytempucs)
    
45.       (vla-put-activeucs
    
46.         (fy:acdoc)
    
47.         (vla-item (fy:acucss) $fytempucs)
    
48.       )
    
49.   )
    
50.   (fy:delucs '("$fytempwcs" "$fytempucs"))
    
51. )
    

;;命名保存当前 UCS<br /> (defun fy:saveucs (name)<br />   (if (and name (not (tblsearch "ucs" name)))<br />     (vla-add (fy:acucss)<br />              (vlax-3d-point (getvar "ucsorg"))<br />              (vlax-3d-point (getvar "ucsxdir"))<br />              (vlax-3d-point (getvar "ucsydir"))<br />              name<br />     )<br />   )<br /> )<br /> ;;删除命名 UCS<br /> (defun fy:delucs (nlst)<br />   (if (= (type nlst) 'STR)<br />     (setq nlst (list nlst))<br />   )<br />   (mapcar '(lambda (x)<br />              (if (tblsearch "ucs" x)<br />                (vla-delete (vla-item (fy:acucs) x))<br />              )<br />            )<br />           nlst<br />   )<br /> )<br /> ;;相当于 command ucs w ，可以放入 begin<br /> (defun fy:setwcs ()<br />   (if (zerop (getvar "worlducs"))<br />     (progn<br />       (fy:saveucs "$fytempucs")<br />       (vla-put-activeucs<br />         (fy:acdoc)<br />         (vla-add (fy:acucss)<br />                  (vlax-3d-point '(0 0 0))<br />                  (vlax-3d-point '(1 0 0))<br />                  (vlax-3d-point '(0 1 0))<br />                  "$fytempwcs"<br />         )<br />       )<br />     )<br />   )<br /> )<br /> ;;恢复 UCS, 可以放入 end<br /> (defun fy:restoreucs ()<br />   (if (tblsearch "ucs" $fytempucs)<br />       (vla-put-activeucs<br />         (fy:acdoc)<br />         (vla-item (fy:acucss) $fytempucs)<br />       )<br />   )<br />   (fy:delucs '("$fytempwcs" "$fytempucs"))<br /> )<br />

yoyoho

感谢 Free-Lancer 分享程序,学习了!