错误捕获？？
这是一个Lisp例程，它在文本、多行文字或尺寸周围绘制一个文本框。我将其修改为绘制该框，并允许用户在框内进行修剪，然后该框就会消失，但如果在任何时候点击escape按钮，则所有osnap设置都会关闭。有人能帮助解决这个lisp上的错误陷阱吗？我试过了，但还没有完全成功。谢谢~诗篇30:5~ (defun c:TB ( )(c:Text-Box));Shortcut
(defun c:Text-Box (/ Cnt# EntName^ Osmode# Pt PtsList@ SS& ss ln1 ln2 eln1 eln2 pln1 pln2 ln1p1 ln1p2 ln2p1 ln2p2
p1 p2 p3 p4 cmd osm)
(setq Osmode# (getvar "OSMODE"))
(princ "\nSelect Text, Mtext or Dimension for Text Box")
(if (setq SS& (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(0 . "DIMENSION")(-4 . "OR>"))))
(progn
(command "UNDO" "BEGIN")
(setvar "osmode" 4)
(setq Cnt# 0)
(repeat (sslength SS&)
(setq EntName^ (ssname SS& Cnt#))
(setq PtsList@ (append (Text-Box EntName^) (list "C")))
(setq Cnt# (+ 4 Cnt#))
(command "PLINE" (foreach Pt PtsList@(command Pt) ))
(command "_offset" "_erase" "_yes" 3.75 (entlast) "0,0,0" "exit")
);repeat
(setvar "OSMODE" Osmode#)
(command "_trim" "_last" "" "_crossing"(while(> (getvar "cmdactive")0)(command pause) ptslist@)"" "_erase" "_previous""")
(command "_offset" "e" "no" "" "_EXIT")
(command "UNDO" "END")
(setvar "OSMODE" Osmode#)
(redraw)
);progn
(princ "\nNo Text, Mtext or Dimension selected.")
)
(princ)
);defun c:Text-Box
;-------------------------------------------------------------------------------
; Text-Box - Function for Text, Mtext and Dimension entities
; Arguments: 1
; Entity^ = Entity name of the Text, Mtext or Dimension to use
; Returns: A list of the four corners of the Text Box
;-------------------------------------------------------------------------------
(defun Text-Box (Entity^ / Ang~ AngEntity~ Corners: EntList@ EntNext^ EntType$
First List@ MovePt NewPts@ Pt Return@ Textboxes@ X X1 X3 Y Y1 Y3 Zero)
;-----------------------------------------------------------------------------
; Corners: - Calculates the four corners of the Text Box
;-----------------------------------------------------------------------------
(defun Corners: (Entity^ / Ang~ Corners@ Dist~ EntList@ Ins Pt Pt1 Pt2 Pt3 Pt4)
(setq EntList@ (entget Entity^)
Corners@ (textbox EntList@)
Ang~ (cdr (assoc 50 EntList@))
Ins (cdr (assoc 10 EntList@))
Pt (mapcar '+ (car Corners@) Ins)
Pt1 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
Pt (mapcar '+ (cadr Corners@) Ins)
Pt3 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
Dist~ (* (distance (car Corners@) (cadr Corners@)) (cos (- (angle Pt1 Pt3) Ang~)))
Pt2 (polar Pt1 Ang~ Dist~)
Pt4 (polar Pt3 Ang~ (- Dist~))
);setq
(list Pt1 Pt2 Pt3 Pt4)
);defun Corners:
;-----------------------------------------------------------------------------
(setq EntList@ (entget Entity^)
EntType$ (cdr (assoc 0 EntList@))
);setq
(cond
((= EntType$ "TEXT")
(setq Return@ (Corners: Entity^))
);case
((or (= EntType$ "MTEXT")(= EntType$ "DIMENSION"))
(command "UNDO" "MARK")
(setq EntNext^ (entlast))
(command "EXPLODE" Entity^)
(if (= EntType$ "DIMENSION")
(command "EXPLODE" (entlast))
);if
(while (setq EntNext^ (entnext EntNext^))
(if (= "TEXT" (cdr (assoc 0 (entget EntNext^))))
(setq Textboxes@ (append Textboxes@ (list (Text-Box EntNext^))))
);if
);while
(command "UNDO" "BACK")
(setq AngEntity~ (angle (nth 0 (nth 0 Textboxes@))(nth 1 (nth 0 Textboxes@)))
Zero (list 0 0)
First t
);setq
(foreach List@ Textboxes@
(foreach Pt List@
(setq X (car Pt) Y (cadr Pt))
(if First
(setq First nil X1 X Y1 Y)
);if
(if (< X X1)(setq X1 X))
(if (< Y Y1)(setq Y1 Y))
);foreach
);foreach
(if (or (< X1 0)(< Y1 0))
(progn
(cond
((and (< X1 0)(< Y1 0))(setq MovePt (list X1 Y1)))
((< X1 0)(setq MovePt (list X1 0)))
((< Y1 0)(setq MovePt (list 0 Y1)))
(setq x1 (+ 1))
(setq y1 (+ 1))
);cond
(command "UCS" "M" MovePt)
);progn
);if
(setq First t)
(foreach List@ Textboxes@
(foreach Pt List@
(setq Ang~ (- (angle Zero Pt) AngEntity~))
(setq Pt (polar Zero Ang~ (distance Zero Pt)))
(setq X (car Pt) Y (cadr Pt))
(if First
(setq First nil X1 X X3 X Y1 Y Y3 Y)
);if
(if (< X X1)(setq X1 X))
(if (< Y Y1)(setq Y1 Y))
(if (> X X3)(setq X3 X))
(if (> Y Y3)(setq Y3 Y))
);foreach
);foreach
(command "UCS" "W")
(setq NewPts@ (list (list X1 Y1)(list X3 Y1)(list X3 Y3)(list X1 Y3)))
(foreach Pt NewPts@
(setq Ang~ (+ (angle Zero Pt) AngEntity~))
(setq Pt (polar Zero Ang~ (distance Zero Pt)))
(setq Return@ (append Return@ (list Pt)))
);foreach
);case
)
Return@
);defun Text-Box
;-------------------------------------------------------------------------------
(princ)
到目前为止，我见过的最好的错误处理程序必须来自一个叫Evgeniy的朋友。
试一试：
（*错误*“”） Se7en，就要打败我了：
(defun c:tb () (c:text-box))
(defun c:text-box(/ *error* vlst ovars cnt# entname^ osmode# pt ptslist@ ss& ss ln1
ln2 eln1 eln2 pln1 pln2 ln1p1 ln1p2 ln2p1
ln2p2 p1 p2 p3 p4 cmd osm)
(defun *error*(msg)
(if ovars
(mapcar 'setvar vlst ovars))
(princ))
(setq vlst'("OSMODE"); <<--- List changed variables here
ovars (mapcar 'getvar vlst))
(princ "\nSelect Text, Mtext or Dimension for Text Box")
(setq osmode# (getvar "OSMODE"))
(if (setq ss& (ssget '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (0 . "DIMENSION") (-4 . "OR>"))))
(progn
(command "UNDO" "BEGIN")
(setvar "osmode" 4)
(setq cnt# 0)
(repeat (sslength ss&)
(setq entname^ (ssname ss& cnt#))
(setq ptslist@ (append (text-box entname^) (list "C")))
(setq cnt# (+ 4 cnt#))
(command "PLINE" (foreach pt ptslist@ (command pt)))
(command "_offset" "_erase" "_yes" 3.75 (entlast) "0,0,0" "exit")
) ;repeat
(setvar "OSMODE" osmode#)
(command "_trim"
"_last"
""
"_crossing"
(while (> (getvar "cmdactive") 0) (command pause) ptslist@)
""
"_erase"
"_previous"
"")
(command "_offset" "e" "no" "" "_EXIT")
(command "UNDO" "END")
(setvar "OSMODE" osmode#)
(redraw)
) ;progn
(princ "\nNo Text, Mtext or Dimension selected.")
)
(mapcar 'setvar vlst ovars)
(princ)
) ;defun c:Text-Box
;-------------------------------------------------------------------------------
; Text-Box - Function for Text, Mtext and Dimension entities
; Arguments: 1
; Entity^ = Entity name of the Text, Mtext or Dimension to use
; Returns: A list of the four corners of the Text Box
;-------------------------------------------------------------------------------
(defun text-box (entity^ / ang~ angentity~ corners:entlist@ entnext^enttype$first
list@ movept newpts@ pt return@ textboxes@ x x1 x3
y y1 y3 zero)
;-----------------------------------------------------------------------------
; Corners: - Calculates the four corners of the Text Box
;-----------------------------------------------------------------------------
(defun corners:(entity^ / ang~ corners@ dist~ entlist@ ins pt pt1 pt2 pt3 pt4)
(setq entlist@ (entget entity^)
corners@ (textbox entlist@)
ang~ (cdr (assoc 50 entlist@))
ins (cdr (assoc 10 entlist@))
pt (mapcar '+ (car corners@) ins)
pt1 (polar ins (+ ang~ (angle ins pt)) (distance ins pt))
pt (mapcar '+ (cadr corners@) ins)
pt3 (polar ins (+ ang~ (angle ins pt)) (distance ins pt))
dist~ (* (distance (car corners@) (cadr corners@)) (cos (- (angle pt1 pt3) ang~)))
pt2 (polar pt1 ang~ dist~)
pt4 (polar pt3 ang~ (- dist~))
) ;setq
(list pt1 pt2 pt3 pt4)
) ;defun Corners:
;-----------------------------------------------------------------------------
(setq entlist@ (entget entity^)
enttype$ (cdr (assoc 0 entlist@))
) ;setq
(cond
((= enttype$ "TEXT")
(setq return@ (corners: entity^))
) ;case
((or (= enttype$ "MTEXT") (= enttype$ "DIMENSION"))
(command "UNDO" "MARK")
(setq entnext^ (entlast))
(command "EXPLODE" entity^)
(if (= enttype$ "DIMENSION")
(command "EXPLODE" (entlast))
) ;if
(while (setq entnext^ (entnext entnext^))
(if (= "TEXT" (cdr (assoc 0 (entget entnext^))))
(setq textboxes@ (append textboxes@ (list (text-box entnext^))))
) ;if
) ;while
(command "UNDO" "BACK")
(setq angentity~ (angle (nth 0 (nth 0 textboxes@)) (nth 1 (nth 0 textboxes@)))
zero (list 0 0)
first t
) ;setq
(foreach list@textboxes@
(foreach ptlist@
(setq x (car pt)
y (cadr pt))
(if first
(setq first nil
x1 x
y1 y)
) ;if
(if (< x x1)
(setq x1 x))
(if (< y y1)
(setq y1 y))
) ;foreach
) ;foreach
(if (or (< x1 0) (< y1 0))
(progn
(cond
((and (< x1 0) (< y1 0)) (setq movept (list x1 y1)))
((< x1 0) (setq movept (list x1 0)))
((< y1 0) (setq movept (list 0 y1)))
(setq x1 (+ 1))
(setq y1 (+ 1))
) ;cond
(command "UCS" "M" movept)
) ;progn
) ;if
(setq first t)
(foreach list@textboxes@
(foreach ptlist@
(setq ang~ (- (angle zero pt) angentity~))
(setq pt (polar zero ang~ (distance zero pt)))
(setq x (car pt)
y (cadr pt))
(if first
(setq first nil
x1 x
x3 x
y1 y
y3 y)
) ;if
(if (< x x1)
(setq x1 x))
(if (< y y1)
(setq y1 y))
(if (> x x3)
(setq x3 x))
(if (> y y3)
(setq y3 y))
) ;foreach
) ;foreach
(command "UCS" "W")
(setq newpts@ (list (list x1 y1) (list x3 y1) (list x3 y3) (list x1 y3)))
(foreach ptnewpts@
(setq ang~ (+ (angle zero pt) angentity~))
(setq pt (polar zero ang~ (distance zero pt)))
(setq return@ (append return@ (list pt)))
) ;foreach
) ;case
)
return@
) ;defun Text-Box
;-------------------------------------------------------------------------------
(princ)
^^没有那么优雅 > ... 没有那么优雅。。。
哦，别难过！当我第一次看到他的解决方案时，我被震撼了（事实上，我差点从椅子上摔下来！）。这太神奇了，不是吗？此外，看起来你也有同样的想法。 这是我在模板中保留的*错误*处理程序。非常欢迎你来这里。我继续并添加了osmode的重置和撤消结束。如果使用这种类型的*错误*处理程序，则必须将其本地化（将其放置在主例程中，并将*错误*添加到局部变量中）。
;;;error handler
(defun *error* (msg)
(and Osmode# (setvar "osmode" Osmode#))
(command "_.undo" "_e")
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort")
) ;_ member
) ;_ not
(princ (strcat "\nError: " msg))
) ;_ if
) ;_ defun 看起来他正在以一种“脚本”的方式思考这个问题——创建一个可以随意评估的编码列表。
好主意
好的一点-我已经讨论了很多关于本地化错误处理程序的问题，而不是
我不确定是否有一种“正确”的方法来实现它，但我更喜欢在重新定义后定位“错误”。 废话，我想每个人都赢了我。
约翰，你再一次证明了你是我的英雄。
哎呀，我讨厌我在mac电脑上粘贴代码的样子。 只是一种选择：
我从David Bethel那里学到了一些东西：
;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun nw_smd ()
(SetUndo)
(setq oldlay(getvar "CLAYER")
olderr*error*
*error* (lambda (e)
(while (> (getvar "CMDACTIVE") 0)
(command)
) ;_end while
(and (/= e "quit / exit abort")
(princ (strcat "\nError: *** " e " *** "))
) ;_end and
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END" "_.U")
) ;_end and
(nw_rmd)
) ;_end lambda
nw_var'(("CMDECHO" . 0)
("MENUECHO" . 0)
("MENUCTL" . 0)
("MACROTRACE" . 0)
("OSMODE" . 0)
("SORTENTS" . 119)
("MODEMACRO" . ".")
("LUPREC" . 2)
("BLIPMODE" . 0)
("EXPERT" . 0)
("SNAPMODE" . 1)
("PLINEWID" . 0)
("ORTHOMODE" . 1)
("GRIDMODE" . 0)
("ELEVATION" . 0)
("THICKNESS" . 0)
("FILEDIA" . 0)
("FILLMODE" . 0)
("SPLFRAME" . 0)
("UNITMODE" . 0)
("TEXTEVAL" . 0)
("ATTDIA" . 0)
("AFLAGS" . 0)
("ATTREQ" . 1)
("ATTMODE" . 1)
("UCSICON" . 1)
("HIGHLIGHT" . 1)
("REGENMODE" . 1)
("COORDS" . 2)
("DRAGMODE" . 2)
("DIMZIN" . 1)
("PDMODE" . 0)
("CECOLOR" . "BYLAYER")
("CELTYPE" . "BYLAYER")
)
) ;_end setq
(foreach v nw_var
(and (getvar (car v))
(setq nw_rst (cons (cons (car v) (getvar (car v))) nw_rst))
(setvar (car v) (cdr v))
) ;_end and
) ;_end foreach
(princ (strcat (getvar "PLATFORM") " Release " (ver)))
(princ)
) ;_end defun
(PDot) ;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun nw_rmd ()
(SetLayer oldlay)
(setq *error* olderr)
(foreach v nw_rst (setvar (car v) (cdr v)))
(command "_.UNDO" "_END")
(prin1)
) ;_end defun
(PDot) ;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL")
) ;_end and
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL")
) ;_end and
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END")
) ;_end and
(command "_.UNDO" "_GROUP")
) ;_end defun
(PDot) ;++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (name / ldef flag)
(command "_.LAYER")
(if (not (tblsearch "LAYER" name))
(command "_Make" name)
(progn
(setq ldef (tblsearch "LAYER" name)
flag (cdr (assoc 70 ldef))
) ;_end setq
(and (= (logand flag 1) 1)
(command "_Thaw" name)
) ;_end and
(and (minusp (cdr (assoc 62 ldef)))
(command "_On" name)
) ;_end and
(and (= (logand flag 4) 4)
(command "_Unlock" name)
) ;_end and
(and (= (logand flag 16) 16)
(princ "\nCannot Set To XRef Dependent Layer")
(quit)
) ;_end and
(command "_Set" name)
) ;_end progn
) ;_end if
(command "")
name
) ;_end defun
;************ Main Program ***************************************
(defun nw_ (/ olderr oldlay nw_var nw_rst)
(nw_smd)
;;;DO YOUR THING HERE
(nw_rmd)
) ;_end defun
(defun C:NW () (nw_))
(if nw_
(princ "\nNew Loaded\n")
) ;_end if
(prin1)
我见过的最复杂的错误模板。。。
页:
[1]
2