程序開頭與結尾的寫法?

taner · 发表于 2007-1-30 15:14:52

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

參考XYP1964與EACHY版主的函數,及fsxm的意見,寫了如下的函數.
請問兩種對error的處理有何區別?

;;; ==================================================================
(defun tfterr (errmsg)
(if (not (member errmsg '("console break" "Function Cancelled")))
(princ (strcat "\nError: " errmsg))
)
(tft-end)
)
(defun tft-begin (varlst) ; varlst为系统变量表如'("cmdecho"
; "osmode")或nil
(command "undo" "be")
(setq *#$*sysvarnl*#$* varlst)
(setq errtmp *error*)
(setq *error* tfterr)
(if *#$*sysvarnl*#$*
(setq *#$*svarl*#$* (mapcar
'getvar
*#$*sysvarnl*#$*
)
)
)
(princ)
)
(defun tft-end ()
(command ".undo" "E")
(if *#$*svarl*#$*
(mapcar
'setvar
*#$*sysvarnl*#$*
*#$*svarl*#$*
)
)
(setq *error* errtmp)
(setq *#$*sysvarnl*#$* nil
*#$*svarl*#$* nil
errtmp nil
)
(princ)
)
;;; ==================================================================
(defun tt-begin (varlst) ; varlst为系统变量表如'("cmdecho"
; "osmode")或nil
(command "undo" "be")
(setq *#$*sysvarnl*#$* varlst)
(defun myerr (errmsg)
(if (not (member errmsg '("console break" "Function Cancelled")))
(princ (strcat "\nError: " errmsg))
)
(tt-end)
)
(setq errtmp *error*)
(setq *error* myerr)
(if *#$*sysvarnl*#$*
(setq *#$*svarl*#$* (mapcar
'getvar
*#$*sysvarnl*#$*
)
)
)
(princ)
)
(defun tt-end ()
(command ".undo" "E")
(if *#$*svarl*#$*
(mapcar
'setvar
*#$*sysvarnl*#$*
*#$*svarl*#$*
)
)
(setq *error* errtmp)
(setq *#$*sysvarnl*#$* nil
*#$*svarl*#$* nil
errtmp nil
)
(princ)
)
;;; ==================================================================

;;; ================================================================== 
(defun tfterr (errmsg) 
  (if (not (member errmsg '("console break" "Function Cancelled"))) 
    (princ (strcat "\nError: " errmsg)) 
  ) 
  (tft-end) 
) 
(defun tft-begin (varlst)               ; varlst为系统变量表如'("cmdecho" 
                                       ; "osmode")或nil 
  (command "undo" "be") 
  (setq *#$*sysvarnl*#$* varlst) 
  (setq errtmp *error*) 
  (setq *error* tfterr) 
  (if *#$*sysvarnl*#$* 
    (setq *#$*svarl*#$* (mapcar 
                          'getvar 
                          *#$*sysvarnl*#$* 
                        ) 
    ) 
  ) 
  (princ) 
) 
(defun tft-end () 
  (command ".undo" "E") 
  (if *#$*svarl*#$* 
    (mapcar 
      'setvar 
      *#$*sysvarnl*#$* 
      *#$*svarl*#$* 
    ) 
  ) 
  (setq *error* errtmp) 
  (setq *#$*sysvarnl*#$* nil 
        *#$*svarl*#$* nil 
        errtmp nil 
  ) 
  (princ) 
) 
;;; ================================================================== 
(defun tt-begin (varlst)               ; varlst为系统变量表如'("cmdecho" 
                                       ; "osmode")或nil 
  (command "undo" "be") 
  (setq *#$*sysvarnl*#$* varlst) 
  (defun myerr (errmsg) 
        (if (not (member errmsg '("console break" "Function Cancelled"))) 
      (princ (strcat "\nError: " errmsg)) 
    ) 
    (tt-end) 
  ) 
  (setq errtmp *error*) 
  (setq *error* myerr) 
  (if *#$*sysvarnl*#$* 
    (setq *#$*svarl*#$* (mapcar 
                          'getvar 
                          *#$*sysvarnl*#$* 
                        ) 
    ) 
  ) 
  (princ) 
) 
(defun tt-end () 
  (command ".undo" "E") 
  (if *#$*svarl*#$* 
    (mapcar 
      'setvar 
      *#$*sysvarnl*#$* 
      *#$*svarl*#$* 
    ) 
  ) 
  (setq *error* errtmp) 
  (setq *#$*sysvarnl*#$* nil 
        *#$*svarl*#$* nil 
        errtmp nil 
  ) 
  (princ) 
) 
;;; ==================================================================

taner · 发表于 2013-6-6 21:17:14

本帖最后由 taner 于 2013-6-6 21:38 编辑

<div class="blockcode"><blockquote>;;; 严重声明，大部份是抄来的，抄的时候没记录出处
;;; 用法：(p-s '("osmode" 0 "cmdecho" 0 ...) t)
(defun p-s (varlst mark)
(setq undo$mark mark)
(if undo$mark
(th-undos)
)
(defun myerr (errmsg)
(if (not (wcmatch (strcase errmsg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " errmsg))
)
(p-e)
)
(setq errtmp *error*)
(setq *error* myerr)
(if varlst
(setq *#$*sysvarnl*#$* (th-sysvar-change varlst))
)
(princ)
)
(defun p-e ()
(if undo$mark
(th-undoe)
)
(if *#$*sysvarnl*#$*
(th-sysvar-change *#$*sysvarnl*#$*)
)
(setq *error* errtmp)
(setq *#$*sysvarnl*#$* nil
errtmp nil
undo$mark nil
)
(princ)
)
(defun th-undos ()
(th-undoe)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
)
(defun th-undoe ()
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
(defun th-sysvar-change (lst / sys-tmp) ; 返回改变前的系统变量值表
(if (= (type lst) 'list)
(mapcar
(function (lambda (x)
(setq sys-tmp (append
sys-tmp
(list (car x))
(list (getvar (car x)))
)
)
(setvar (car x) (cadr x))
)
)
(txt-lst-split lst 2)
)
)
sys-tmp
)
(defun txt-lst-split (li n / return a len)
(while li
(setq a nil
len (length li)
)
(repeat (if (<= n len)
n
len
)
(setq a (cons (car li) a)
li (cdr li)
)
)
(setq return (cons (reverse a) return))
)
(reverse return)
)

<div class="blockcode"><blockquote>;;; 严重声明，大部份是抄来的，抄的时候没记录出处 
;;; 用法：(p-s '("osmode" 0 "cmdecho"  0 ...) t) 
(defun p-s (varlst mark) 
  (setq undo$mark mark) 
  (if undo$mark 
    (th-undos) 
  ) 
  (defun myerr (errmsg) 
    (if (not (wcmatch (strcase errmsg t) "*break,*cancel*,*exit*")) 
      (princ (strcat "\nError: " errmsg)) 
    ) 
    (p-e) 
  ) 
  (setq errtmp *error*) 
  (setq *error* myerr) 
  (if varlst 
    (setq *#$*sysvarnl*#$* (th-sysvar-change varlst)) 
  ) 
  (princ) 
) 
(defun p-e () 
  (if undo$mark 
    (th-undoe) 
  ) 
  (if *#$*sysvarnl*#$* 
    (th-sysvar-change *#$*sysvarnl*#$*) 
  ) 
  (setq *error* errtmp) 
  (setq *#$*sysvarnl*#$* nil 
        errtmp nil 
        undo$mark nil 
  ) 
  (princ) 
) 
(defun th-undos () 
  (th-undoe) 
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) 
) 
(defun th-undoe () 
  (while (= 8 (logand 8 (getvar 'undoctl))) 
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) 
  ) 
) 
(defun th-sysvar-change        (lst / sys-tmp)        ; 返回改变前的系统变量值表 
  (if (= (type lst) 'list) 
    (mapcar 
      (function        (lambda        (x) 
                  (setq        sys-tmp        (append 
                                  sys-tmp 
                                  (list (car x)) 
                                  (list (getvar (car x))) 
                                ) 
                  ) 
                  (setvar (car x) (cadr x)) 
                ) 
      ) 
      (txt-lst-split lst 2) 
    ) 
  ) 
  sys-tmp 
) 
 
(defun txt-lst-split (li n / return a len) 
  (while li 
    (setq a   nil 
          len (length li) 
    ) 
    (repeat (if        (<= n len) 
              n 
              len 
            ) 
      (setq a  (cons (car li) a) 
            li (cdr li) 
      ) 
    ) 
    (setq return (cons (reverse a) return)) 
  ) 
  (reverse return) 
)

haibinpro · 发表于 2007-3-5 08:03:54

*#$*是什么来的。

yy5heng · 发表于 2007-3-5 21:25:30

我也对这种*开头的变量感到晕菜，高手介绍一二。

taner · 发表于 2007-7-27 10:11:41

[FONT=courier new]
;;; valst为表如'(("odmode" 1)("cmdecho" 0)...)或nil。
;;;如果主程序中沒有用COMMAND命令，則在主程序运行的起
;;;始位置加一个无谓的command，如“(command "color" "")”。
(defun lovett (varlst / sysnamelst valuelst)
(command "undo" "be")
(if varlst
(setq *#$*sysvarnl*#$* (mapcar
'car
varlst
)
sysnamelst *#$*sysvarnl*#$*
valuelst (mapcar
'cadr
varlst
)
)
)
(defun myerr (errmsg)
(if (not (member errmsg '("console break" "Function Cancelled")))
(princ (strcat "\nError: " errmsg))
)
(hatett)
)
(setq errtmp *error*)
(setq *error* myerr)
(if *#$*sysvarnl*#$*
(progn
(setq *#$*svarl*#$* (mapcar
'getvar
*#$*sysvarnl*#$*
)
)
(mapcar
'setvar
sysnamelst
valuelst
)
)
)
(princ)
)
(defun hatett ()
(command ".undo" "E")
(if *#$*svarl*#$*
(mapcar
'setvar
*#$*sysvarnl*#$*
*#$*svarl*#$*
)
)
(setq *error* errtmp)
(setq *#$*sysvarnl*#$* nil
*#$*svarl*#$* nil
errtmp nil
)
(princ)
)
[/FONT]

[FONT=courier new] 
;;; valst为表如'(("odmode" 1)("cmdecho" 0)...)或nil。 
;;;如果主程序中沒有用COMMAND命令，則在主程序运行的起 
;;;始位置加一个无谓的command，如“(command "color" "")”。 
(defun lovett (varlst  / sysnamelst valuelst) 
  (command "undo" "be") 
  (if varlst 
    (setq *#$*sysvarnl*#$* (mapcar 
                             'car 
                             varlst 
                           ) 
          sysnamelst *#$*sysvarnl*#$* 
          valuelst (mapcar 
                     'cadr 
                     varlst 
                   ) 
    ) 
  ) 
  (defun myerr (errmsg) 
    (if (not (member errmsg '("console break" "Function Cancelled"))) 
      (princ (strcat "\nError: " errmsg)) 
    ) 
    (hatett) 
  ) 
  (setq errtmp *error*) 
  (setq *error* myerr) 
  (if *#$*sysvarnl*#$* 
    (progn 
      (setq *#$*svarl*#$* (mapcar 
                            'getvar 
                            *#$*sysvarnl*#$* 
                          ) 
      ) 
      (mapcar 
        'setvar 
        sysnamelst 
        valuelst 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun hatett () 
      (command ".undo" "E") 
    (if *#$*svarl*#$* 
    (mapcar 
      'setvar 
      *#$*sysvarnl*#$* 
      *#$*svarl*#$* 
    ) 
  ) 
  (setq *error* errtmp) 
  (setq *#$*sysvarnl*#$* nil 
        *#$*svarl*#$* nil 
        errtmp nil 
  ) 
  (princ) 
) 
  [/FONT]

zml84 · 发表于 2007-7-27 11:54:58

一般的小功能程序，实在没有必要做得这么复杂。
将错误消除在内部才是正道。

梦断江南 · 发表于 2007-7-29 16:49:58

(command ".undo" "E")
没有必要写进去，根据需要加。有些函数不希望调用命令的

taner · 发表于 2007-7-31 08:13:46

;;;看看明經上的一段文章
一个完善的程序应该有较好的出错处理，这是在所有Lisp教材上都提及的，但程序的Undo处理就说得很少或没有提及。
其实Undo处理对程序来说也是非常重要的，尤其对有较多输出的复杂程序而言，不能解决Undo问题，使用起来会极不方便。
对于Undo问题的解决，一种方法是尽量少用或不用command函数，即不调用原始命令，这是一种较好的方法，但必须注意的是，一段程序必须至少有一次调用command函数，否则Undo命令将取消程序运行前的前一次命令，解决的方法是在程序运行的起始位置加一个无谓的command，如“(command "color" "")”。
有时不使用command函数不能达到我们要求的一些功能，或使得程序过于复杂，我们可能需要使用一些command函数（原始命令），这是就应该在程序中进行Undo处理，即使用Undo命令的编组功能。
例五是一段程序出错函数与Undo处理的示例。
************************************************
;;例五
(defun newerr (s) ;出错函数
(if s
(progn
(term_dialog) ;使用对话框时使用
(if olderr (setq *error* olderr)) ;出错函数恢复
(if oldvar (setvar ... oldvar)) ;系统变量恢复
(if olderr (setq *error* olderr)) ;出错函数恢复
(command "_.undo" "_e") ;Undo编组结束
)
)
(princ)
)
(defun c:my(/ ...) ;主程序（主函数）
(setvar "cmdecho" 0) ;取消命令回显提示
(command "_.undo" "_BE") ;Undo编组开始
(setq olderr *error* *error* newerr) ;调用自定义出错函数
(setq oldvar (getvar ...)) ;保存相关系统变量
(setvar ... ;设置系统变量
... ;程序段
...
(setvar ... oldvar) ;恢复系统变量
(setq *error* olderr) ;恢复出错函数
(command "_.undo" "_E") ;结束Undo命令编组
(princ) ;取消程序返回值
)

;;;看看明經上的一段文章 
一个完善的程序应该有较好的出错处理，这是在所有Lisp教材上都提及的，但程序的Undo处理就说得很少或没有提及。 
    其实Undo处理对程序来说也是非常重要的，尤其对有较多输出的复杂程序而言，不能解决Undo问题，使用起来会极不方便。 
    对于Undo问题的解决，一种方法是尽量少用或不用command函数，即不调用原始命令，这是一种较好的方法，但必须注意的是，一段程序必须至少有一次调用command函数，否则Undo命令将取消程序运行前的前一次命令，解决的方法是在程序运行的起始位置加一个无谓的command，如“(command "color" "")”。 
    有时不使用command函数不能达到我们要求的一些功能，或使得程序过于复杂，我们可能需要使用一些command函数（原始命令），这是就应该在程序中进行Undo处理，即使用Undo命令的编组功能。 
    例五是一段程序出错函数与Undo处理的示例。 
************************************************ 
;;例五 
(defun newerr (s)                                    ;出错函数 
  (if s 
    (progn 
      (term_dialog)                                 ;使用对话框时使用 
      (if olderr (setq *error* olderr))             ;出错函数恢复 
      (if oldvar (setvar ... oldvar))               ;系统变量恢复 
      (if olderr (setq *error* olderr))             ;出错函数恢复 
      (command "_.undo" "_e")                       ;Undo编组结束 
    ) 
  ) 
  (princ) 
) 
 
(defun c:my(/ ...)                                  ;主程序（主函数） 
  (setvar "cmdecho" 0)                              ;取消命令回显提示 
  (command "_.undo" "_BE")                          ;Undo编组开始 
  (setq olderr *error* *error* newerr)              ;调用自定义出错函数 
  (setq oldvar (getvar ...))                        ;保存相关系统变量 
  (setvar ...                                       ;设置系统变量 
  ...                                               ;程序段 
  ... 
  (setvar ... oldvar)                               ;恢复系统变量 
  (setq *error* olderr)                             ;恢复出错函数 
  (command "_.undo" "_E")                           ;结束Undo命令编组 
  (princ)                                           ;取消程序返回值 
)

Dream.Fei · 发表于 2007-7-31 12:02:59

看了这么多，我也帖一个自己的。

;;______存储系统变量______
(defun cmdme0 (/ *syslst* *sysval* *acaddoc* )
(vl-load-com)
(setq *acaddoc* (vla-get-activedocument (vlax-get-acad-object)))
(setq *syslst* '("AUNITS" "AUTOSNAP" "AUPREC" ;|"DRAWORDERCTL"|; "ATTDIA"
"BLIPMODE" "CECOLOR" "CELTYPE" "CELTSCALE" "CELWEIGHT"
"CLAYER" ;|"CENTERMT"|; "CHAMFERA" "CHAMFERB" "CHAMFERC"
"CHAMFERD" "CHAMMODE" "CIRCLERAD" "CMDECHO" "CMLSCALE"
"CMLSTYLE" "CTAB" "CURSORSIZE" ;|"DBLCLKEDIT"|; "FILEDIA"
"FILLETRAD" "FILLMODE" ;|"HPGAPTOL"|; "HPANG" "HIGHLIGHT"
"LUNITS" "NOMUTT" "PICKFIRST" "TEXTSTYLE" "Tilemode"
"OSMODE" "ORTHOMODE" "PLINEWID" "PELLIPSE" "PROXYGRAPHICS"
"LTSCALE" "PSLTSCALE" "INSUNITS" "SNAPANG" "qaflags"
)
)
(setq *sysval* (mapcar 'getvar *syslst*))
(vlax-ldata-put "Sys-Me" "sysval" *sysval*)
(vlax-ldata-put "Sys-Me" "syslst" *syslst*)
(setvar "cmdecho" 0)
(vla-startundomark *acaddoc*)
)
;;______还原系统变量______
(defun cmdme1 (/ *syslst* *sysval* *acaddoc* old_time new_time)
(setvar "cmdecho" 1)
(term_dialog)
(redraw)
(setq *syslst* (vlax-ldata-get "Sys-Me" "syslst")
*sysval* (vlax-ldata-get "Sys-Me" "sysval")
*acaddoc* (vla-get-activedocument (vlax-get-acad-object))
)
(mapcar 'setvar *syslst* *sysval*)
(vla-endundomark *acaddoc*)
(and (vlax-ldata-get "Dream.Fei" "Dcl_name")
(vl-file-size (vlax-ldata-get "Dream.Fei" "Dcl_name"))
(not(vl-file-delete (vlax-ldata-get "Dream.Fei" "Dcl_name")))
(princ "\n有临时dcl文件存在，但该文件无法被删除")
)
(princ)
)
应用:
(defun c:test(/ *olderr* *myerr*)
(defun *myerr* (msg)
(and (/= msg "Function canceled")
(/= msg "quit / exit abort")
(princ (strcat "\nError: " msg))
)
(cmdme1)
)
(setq *olderr* *error*)
(setq *error* *myerr*)
(cmdme0)
.........
(cmdme1)
)

;;______存储系统变量______ 
(defun cmdme0 (/ *syslst* *sysval* *acaddoc* ) 
  (vl-load-com) 
  (setq *acaddoc* (vla-get-activedocument (vlax-get-acad-object))) 
  (setq        *syslst* '("AUNITS"          "AUTOSNAP"         "AUPREC" ;|"DRAWORDERCTL"|;   "ATTDIA" 
                   "BLIPMODE"          "CECOLOR"         "CELTYPE"        "CELTSCALE"    "CELWEIGHT" 
                   "CLAYER" ;|"CENTERMT"|;         "CHAMFERA"        "CHAMFERB"     "CHAMFERC" 
                   "CHAMFERD"          "CHAMMODE"         "CIRCLERAD"        "CMDECHO"      "CMLSCALE" 
                   "CMLSTYLE"          "CTAB"         "CURSORSIZE" ;|"DBLCLKEDIT"|; "FILEDIA" 
                   "FILLETRAD"          "FILLMODE" ;|"HPGAPTOL"|;        "HPANG"               "HIGHLIGHT" 
                   "LUNITS"          "NOMUTT"         "PICKFIRST"        "TEXTSTYLE"    "Tilemode" 
                   "OSMODE"          "ORTHOMODE"         "PLINEWID"        "PELLIPSE"     "PROXYGRAPHICS" 
                   "LTSCALE"          "PSLTSCALE"         "INSUNITS"        "SNAPANG"      "qaflags" 
                  ) 
  ) 
  (setq *sysval* (mapcar 'getvar *syslst*)) 
  (vlax-ldata-put "Sys-Me" "sysval" *sysval*) 
  (vlax-ldata-put "Sys-Me" "syslst" *syslst*) 
  (setvar "cmdecho" 0) 
  (vla-startundomark *acaddoc*) 
) 
;;______还原系统变量______ 
(defun cmdme1 (/ *syslst* *sysval* *acaddoc* old_time new_time) 
  (setvar "cmdecho" 1) 
  (term_dialog) 
  (redraw) 
  (setq        *syslst*  (vlax-ldata-get "Sys-Me" "syslst") 
        *sysval*  (vlax-ldata-get "Sys-Me" "sysval") 
        *acaddoc* (vla-get-activedocument (vlax-get-acad-object)) 
  ) 
  (mapcar 'setvar *syslst* *sysval*) 
  (vla-endundomark *acaddoc*) 
  (and (vlax-ldata-get "Dream.Fei" "Dcl_name") 
       (vl-file-size (vlax-ldata-get "Dream.Fei" "Dcl_name")) 
       (not(vl-file-delete (vlax-ldata-get "Dream.Fei" "Dcl_name"))) 
       (princ "\n有临时dcl文件存在，但该文件无法被删除") 
  ) 
  (princ) 
) 
 
应用: 
(defun c:test(/ *olderr* *myerr*) 
 (defun *myerr* (msg) 
  (and (/= msg "Function canceled") 
         (/= msg "quit / exit abort") 
         (princ (strcat "\nError: " msg)) 
  ) 
  (cmdme1) 
) 
(setq *olderr* *error*) 
(setq *error*  *myerr*) 
(cmdme0) 
......... 
(cmdme1) 
)

一：需要还原哪些变量可以自己定,而且很方便。
二：没有全局变量，省得冲突。
三：有没有对话框都可以直接(terM_dialog)没啥影响。
四：不使用command命令.

vl-file-*** 段是用来假设如果有临时的dcl文件。一般动态生成的dcl我都是存在那个东东里面。

----
至于5楼所说的，我也这样觉得。
但问题是，这个是系统初始和还原，与程序大小没什么必然联系，这只不过是为了通用而写。

另外一个疑惑就是 *error* 函数的使用，我一直想写个通用的，但没搞得定。还望版主们出手给个点子。

taner · 发表于 2007-8-3 08:47:23

请教一下，(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))与(command "undo" "be")有啥区别？

Dream.Fei · 发表于 2007-8-4 17:39:18

没啥区别，只是不用command的另一种方式而已。

sicky111 · 发表于 2013-6-7 12:28:54

确实，一些简单的程式不需要把头尾搞得太复杂，应该视情况而定。

cable2004 · 发表于 2014-3-20 23:02:51

源码是好东西

xvjiex · 发表于 2021-6-7 00:41:56

感谢分享程序開頭與結尾的寫法

账号		自动登录	找回密码
密码			立即注册

[每日一码] 程序開頭與結尾的寫法?

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

评分