[VLISP函数]： 一般程序 *Error* Begin End 写法

eachy

2. 
   
3. ;; Form [url]www.xdcad.net[/url] eachy 2005.9.21
   
4. ;; 一般程序 *Error* Begin End 写法
   
5. ;;; 如果发生error (例如 ctrl-c)
   
6. ;;; 激活本命令...
   
7. (defun xd-error (st)
   
8.   (if (/= st "函数已取消")
   
9.     (princ "\n*取消*")
   
10.   )
    
11.   (xd-end)
    
12.   (princ)
    
13. )
    
14. ;;初始化命令，保存系统变量，标记程序开始
    
15. ;; sysvarlst 1 系统变量列表，
    
16. ;;             多个 '(("cmdecho" 0) ("osmode" 0) ...)
    
17. ;;             单个  '("osmode" 0)
    
18. ;;           2 nil 程序中不进行系统变量改变
    
19. (defun xd-begin        (sysvarlst /)
    
20.   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
21.   (if (/= (length sysvarlst) 0)
    
22.     (setq xd-sysvar_mlst
    
23.            (mapcar
    
24.              '(lambda (x / y)
    
25.                 (if (= (type x) 'LIST)
    
26.                   (setq y (list (car x) (getvar (car x))))
    
27.                   (setq y (list x (getvar x)))
    
28.                 )
    
29.                 (if (/= (type x) 'STR)
    
30.                   (eval (cons 'setvar x))
    
31.                 )
    
32.                 y;_ 保存系统变量
    
33.               )
    
34.              sysvarlst
    
35.            )
    
36.     )
    
37.   )
    
38.   (setq        xd-olderr *error*
    
39.         *error*        xd-error
    
40.   )
    
41.   (princ)
    
42. )
    
43. ;;标记程序结束
    
44. (defun xd-end ()
    
45.   (if xd-sysvar_mlst
    
46.     (mapcar '(lambda (x)
    
47.                (eval (cons 'setvar x))
    
48.              )
    
49.             xd-sysvar_mlst
    
50.     )
    
51.   )
    
52.   ;|
    
53.   ;;统一保存程序中生成的临时实体，取消时要删除
    
54.   ;;根据需要添加
    
55.   (if $ea_temp_object
    
56.     ;(not (vlax-erased-p $ea_temp_object))
    
57.     (cond
    
58.       ((= (type $ea_temp_object) 'VLA-OBJECT)
    
59.        (vla-delete $ea_temp_object)
    
60.       )
    
61.       ((= (type $ea_temp_object) 'ENAME)
    
62.        (entdel $ea_temp_object)
    
63.       )
    
64.       (t (vlax-release-object $ea_temp_object))
    
65.     )
    
66.   )|;
    
67.   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    
68.   (setq *error* xd-olderr)
    
69.   (setq        xd-sysvar_mlst         nil
    
70.         xd-olderr        nil
    
71.         $ea_temp_object         nil
    
72.   )
    
73.   (princ)
    
74. )

<br /> ;; Form [url]www.xdcad.net[/url] eachy 2005.9.21<br /> ;; 一般程序 *Error* Begin End 写法<br /> ;;; 如果发生error (例如 ctrl-c)<br /> ;;; 激活本命令...<br /> (defun xd-error (st)<br />   (if (/= st "函数已取消")<br />     (princ "\n*取消*")<br />   )<br />   (xd-end)<br />   (princ)<br /> )<br /> ;;初始化命令，保存系统变量，标记程序开始<br /> ;; sysvarlst 1 系统变量列表，<br /> ;;             多个 '(("cmdecho" 0) ("osmode" 0) ...)<br /> ;;             单个  '("osmode" 0)<br /> ;;           2 nil 程序中不进行系统变量改变<br /> (defun xd-begin        (sysvarlst /)<br />   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) <br />   (if (/= (length sysvarlst) 0)<br />     (setq xd-sysvar_mlst<br />            (mapcar<br />              '(lambda (x / y)<br />                 (if (= (type x) 'LIST)<br />                   (setq y (list (car x) (getvar (car x))))<br />                   (setq y (list x (getvar x)))<br />                 )<br />                 (if (/= (type x) 'STR)<br />                   (eval (cons 'setvar x))<br />                 )<br />                 y;_ 保存系统变量<br />               )<br />              sysvarlst<br />            )<br />     )<br />   )<br />   (setq        xd-olderr *error*<br />         *error*        xd-error<br />   )<br />   (princ)<br /> )<br /> ;;标记程序结束<br /> (defun xd-end ()<br />   (if xd-sysvar_mlst<br />     (mapcar '(lambda (x)<br />                (eval (cons 'setvar x))<br />              )<br />             xd-sysvar_mlst<br />     )<br />   )<br />   ;|<br />   ;;统一保存程序中生成的临时实体，取消时要删除<br />   ;;根据需要添加<br />   (if $ea_temp_object<br />     ;(not (vlax-erased-p $ea_temp_object))<br />     (cond<br />       ((= (type $ea_temp_object) 'VLA-OBJECT)<br />        (vla-delete $ea_temp_object)<br />       )<br />       ((= (type $ea_temp_object) 'ENAME)<br />        (entdel $ea_temp_object)<br />       )<br />       (t (vlax-release-object $ea_temp_object))<br />     )<br />   )|;<br />   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br />   (setq *error* xd-olderr)<br />   (setq        xd-sysvar_mlst         nil<br />         xd-olderr        nil<br />         $ea_temp_object         nil<br />   )<br />   (princ)<br /> )