发一个具有系统变量、捕捉设置错误自动恢复的代码模版

vectra

1. (vl-load-com)
   
2. 
   
3. (defun p-error-handler (s)
   
4.   (if (or (= s "Function cancelled")
   
5.     (= s "quit / exit abort")
   
6.     (= s "函数被取消")
   
7.       )
   
8.     (princ)
   
9.     (princ s)
   
10.   )
    
11.   (while (not (equal (getvar "CMDNAMES") "")) (command nil))
    
12.   (p-osnap-restore)
    
13.   (p-undogroup-end)
    
14.   (p-error-end)
    
15.   (princ)
    
16. )
    
17. 
    
18. 
    
19. (defun p-osnap-disable ()
    
20.   ;; g-saved-osmode - 全局变量
    
21.   ;; 保存捕捉状态，仅保存第一次调用p-osnap-disable时的osmode 值
    
22.   (if (null g-saved-osmode)
    
23.     (setq g-saved-osmode (getvar "osmode"))
    
24.   )
    
25.   ;; 禁用捕捉
    
26.   (if (< g-saved-osmode 16384)
    
27.     (setvar "osmode" (+ g-saved-osmode 16384))
    
28.   )
    
29. )
    
30. 
    
31. 
    
32. (defun p-osnap-restore ()
    
33.   ;; 仅当g-saved-osmode值不为nil时才进行恢复
    
34.   (if (not (null g-saved-osmode))
    
35.     (progn
    
36.       (setvar "osmode" g-saved-osmode)
    
37.       (setq g-saved-osmode nil)
    
38.     )
    
39.   )
    
40. )
    
41. 
    
42. 
    
43. (defun p-undogroup-start ()
    
44.   ;; g-undogroup-started - 全局变量
    
45.   (if (not g-undogroup-started)
    
46.     (progn
    
47. ;;;      (command ".undo" "BE")
    
48.       (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
49.       (setq g-undogroup-started t)
    
50.     )
    
51.   )
    
52. )
    
53. 
    
54. 
    
55. (defun p-undogroup-end ()
    
56.   (if g-undogroup-started
    
57. ;;;    (command ".undo" "E")
    
58.     (progn
    
59.       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    
60.       (setq g-undogroup-started nil)
    
61.     )
    
62.   )
    
63. )
    
64. 
    
65. 
    
66. (defun p-safe-setvars (pairs / changed name old value)
    
67.   (foreach pair  pairs
    
68.     (setq name  (car pair)
    
69.     value  (cdr pair)
    
70.     old  (getvar name)
    
71.     )
    
72.     ;; 如果old = nil，可能是当前CAD版本不支持该变量
    
73.     ;; 此时放弃对变量进行修改
    
74.     (if  old
    
75.       (progn
    
76.   (setq changed (cons (cons name old) changed))
    
77.   (setvar name value)
    
78.       )
    
79.     )
    
80.   )
    
81.   changed ;_ 返回旧值列表
    
82. )
    
83. 
    
84. 
    
85. (defun p-error-start (vars /)
    
86.   (setq g-saved-sysvars (p-safe-setvars vars))
    
87. )
    
88. 
    
89. 
    
90. (defun p-error-end ()
    
91.   (if g-saved-sysvars
    
92.     (progn
    
93.       (p-safe-setvars g-saved-sysvars)
    
94.       (setq g-saved-sysvars nil)
    
95.     )
    
96.   )
    
97. )
    
98. 
    
99. 
    
100. (defun c:test (/ *error* p1 p2)
     
101.   (defun *error* (s)
     
102.     (p-error-handler s)
     
103.     ;; TODO:在此增加额外的错误恢复处理....
     
104.   )
     
105. 
     
106.   ;; 需要设置其它系统变量在表中增加，p-error-end 函数自动恢复旧值
     
107.   (p-error-start '(("CMDECHO" . 0)))
     
108. 
     
109.   ;; TODO: 增加用户交互代码，如getpoint getreal getkword...
     
110.   (setq  p1 (getpoint)
     
111.   p2 (getpoint)
     
112.   )
     
113. 
     
114.   (p-undogroup-start) ;_根据需要增加，后续内容将改变图形数据库
     
115. 
     
116.   (p-osnap-disable) ;_根据需要增加，要在用户交互代码之后，受影响的绘图过程前调用
     
117. 
     
118.   ;; TODO:在此增加用户过程
     
119.   (command ".LINE" p1 p2 "")
     
120. 
     
121.   (p-osnap-restore) ;_与p-osnap-disable成对使用
     
122. 
     
123.   (p-undogroup-end) ;_与p-undogroup-start成对使用
     
124.   (p-error-end)
     
125.   (princ)
     
126. )

(vl-load-com)<br /> <br /> (defun p-error-handler (s)<br />   (if (or (= s "Function cancelled")<br />     (= s "quit / exit abort")<br />     (= s "函数被取消")<br />       )<br />     (princ)<br />     (princ s)<br />   )<br />   (while (not (equal (getvar "CMDNAMES") "")) (command nil))<br />   (p-osnap-restore)<br />   (p-undogroup-end)<br />   (p-error-end)<br />   (princ)<br /> )<br /> <br /> <br /> (defun p-osnap-disable ()<br />   ;; g-saved-osmode - 全局变量<br />   ;; 保存捕捉状态，仅保存第一次调用p-osnap-disable时的osmode 值<br />   (if (null g-saved-osmode)<br />     (setq g-saved-osmode (getvar "osmode"))<br />   )<br />   ;; 禁用捕捉<br />   (if (< g-saved-osmode 16384)<br />     (setvar "osmode" (+ g-saved-osmode 16384))<br />   )<br /> )<br /> <br /> <br /> (defun p-osnap-restore ()<br />   ;; 仅当g-saved-osmode值不为nil时才进行恢复<br />   (if (not (null g-saved-osmode))<br />     (progn<br />       (setvar "osmode" g-saved-osmode)<br />       (setq g-saved-osmode nil)<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun p-undogroup-start ()<br />   ;; g-undogroup-started - 全局变量<br />   (if (not g-undogroup-started)<br />     (progn<br /> ;;;      (command ".undo" "BE")<br />       (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))<br />       (setq g-undogroup-started t)<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun p-undogroup-end ()<br />   (if g-undogroup-started<br /> ;;;    (command ".undo" "E")<br />     (progn<br />       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br />       (setq g-undogroup-started nil)<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun p-safe-setvars (pairs / changed name old value)<br />   (foreach pair  pairs<br />     (setq name  (car pair)<br />     value  (cdr pair)<br />     old  (getvar name)<br />     )<br />     ;; 如果old = nil，可能是当前CAD版本不支持该变量<br />     ;; 此时放弃对变量进行修改<br />     (if  old<br />       (progn<br />   (setq changed (cons (cons name old) changed))<br />   (setvar name value)<br />       )<br />     )<br />   )<br />   changed ;_ 返回旧值列表<br /> )<br /> <br /> <br /> (defun p-error-start (vars /)<br />   (setq g-saved-sysvars (p-safe-setvars vars))<br /> )<br /> <br /> <br /> (defun p-error-end ()<br />   (if g-saved-sysvars<br />     (progn<br />       (p-safe-setvars g-saved-sysvars)<br />       (setq g-saved-sysvars nil)<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun c:test (/ *error* p1 p2)<br />   (defun *error* (s)<br />     (p-error-handler s)<br />     ;; TODO:在此增加额外的错误恢复处理....<br />   )<br /> <br />   ;; 需要设置其它系统变量在表中增加，p-error-end 函数自动恢复旧值<br />   (p-error-start '(("CMDECHO" . 0)))<br /> <br />   ;; TODO: 增加用户交互代码，如getpoint getreal getkword...<br />   (setq  p1 (getpoint)<br />   p2 (getpoint)<br />   )<br /> <br />   (p-undogroup-start) ;_根据需要增加，后续内容将改变图形数据库<br /> <br />   (p-osnap-disable) ;_根据需要增加，要在用户交互代码之后，受影响的绘图过程前调用<br /> <br />   ;; TODO:在此增加用户过程<br />   (command ".LINE" p1 p2 "")<br /> <br />   (p-osnap-restore) ;_与p-osnap-disable成对使用<br /> <br />   (p-undogroup-end) ;_与p-undogroup-start成对使用<br />   (p-error-end)<br />   (princ)<br /> )

sicky111

谢谢楼主分享。

wzg356

lisp要达到自由的境界不可能啊，各有各的招数,顶一个

xiaolong1487

顶起，又学一招

伪书虫86

先收了，有空再看

zhangrunze

感谢分享~