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