[编程交流] 错误捕获？？

(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 [email="Textboxes@))(nth"]Textboxes@))(nth[/email] 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)

(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    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)

;;;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

 ;++++++++++++ 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)