;Textumrandung-Routine im Original von Stephan Vette, Dortmund 02/1994
;Erzeugt eine Schattenbox um einen Text
;Version: 2.0 (13.03.2006)
;Rev: cSol rinm, BEAT FRIEDRICH Haustechnik-Planungsbuero, 8952 Schlieren, Schweiz) 
;Datum: 02/1994, letzte Aenderung siehe bei Version
(defun C:TZU (/      lay_alt       farb_alt      lin_alt       poly_wid
             as1    nn     fp     absol  absolt aa     ab     n
             x1     x2     yx     teob   ym     yn     yo     ya
             yv     textobj       tewe   dd     tb     xmin   xmax
             tebo   y2     y1     xp1    xp2    xp3    yp1    yp2
             yp3    p1     p2     p3     p4     p5     p6     p7
             neu_lay       cmde   osme   bmde
             )

   (defun M:FEHLER (MSG)
    (altsv)
    (setq *ERROR* M:MD_ERR)
   (princ
     (strcat "Fehler! AutoCAD meldet: \"" MSG "\" als Ursache.")
      ) ;_ end of princ
    (princ)
    ) ;_ end of defun
  (defun altsv ()
    (setvar "CMDECHO" cmde)
    (setvar "OSMODE" osme)
    (setvar "BLIPMODE" bmde)
    (setvar "clayer" lay_alt)
    (setvar "cecolor" farb_alt)
    (setvar "celtype" lin_alt)
    (setvar "plinewid" poly_wid)
    (command "._ucs" "_pr")
    ) ;_ end of defun
    (setq M:MD_ERR *ERROR*
        *ERROR*  M:FEHLER
        ) ;_ end of setq
  (setq cmde (getvar "CMDECHO")
        osme (getvar "OSMODE")
        bmde (getvar "BLIPMODE")
        ) ;_ end of setq
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setvar "OSMODE" 0)
  (setq lay_alt  (getvar "clayer")
        farb_alt (getvar "cecolor")
        lin_alt  (getvar "celtype")
        poly_wid (getvar "plinewid")
        ) ;_ end of setq
  (setq as1    (ssget (quote ((0 . "TEXT"))))
        nn     (sslength as1)
        fp     (ssname as1 0)
        absol  (* (cdr (assoc 40 (entget fp))) 1.0)
        absolt (* absol 0.5)
        aa     (* absolt 0.4)
        ab     (* aa 2)
        ) ;_ end of setq
  (command "._ucs" "_ob" fp)
  (setq n  0
        x1 0.0
        x2 0.0
        yx -10000.0
        ) ;_ end of setq
  (repeat nn
    (setq teob (entget (ssname as1 n)))
    (setq ym (cadr (cdr (assoc 10 teob))))
    (setq yx (max yx ym)
          n  (1+ n)
          ) ;_ end of setq
    ) ;_ end of repeat
  (setq n  0
        yn yx
        ) ;_ end of setq
  (repeat nn
    (setq yo (cadr (cdr (assoc 10 (entget (ssname as1 n))))))
    (setq yn (min yn yo)
          n  (1+ n)
          ) ;_ end of setq
    ) ;_ end of repeat
  (setq n 0)
  (setq ya (- yx yn))
  (repeat nn
    (setq yv (cadr (cdr (assoc 10 (entget (ssname as1 n))))))
    (if (eq yv yx)
      (setq textobj (ssname as1 n))
      (setq n (1+ n))
      ) ;_ end of if
    ) ;_ end of repeat
  (setq n  0
        yn yx
        ) ;_ end of setq
  (setq tewe (cdr (assoc 1 (entget textobj))))
  (if (wcmatch tewe "%%o*,*%%o*,*%%o")
    (setq dd (* absol 0.245))
    (setq dd 0)
    ) ;_ end of if
  (setq n 0)
  (command "._ucs" "_pr")
  (command "._ucs" "_ob" textobj)
  (repeat nn
    (setq tb   (textbox (entget (ssname as1 n)))
          xmin (caar tb)
          xmax (caadr tb)
          x1   (min xmin x1)
          x2   (max xmax x2)
          n    (1+ n)
          ) ;_ end of setq
    ) ;_ end of repeat
  (setq tebo (textbox (entget textobj))
        y2   (- (cadadr tebo) dd)
        y1   (- y2 ya)
        ) ;_ end of setq
  (setq xp1 (- x1 absolt)
        xp2 (+ x2 absolt)
        xp3 (+ aa xp2)
        yp1 (- y1 (* absolt 3.4))
        yp2 (+ y2 absolt)
        yp3 (- yp1 aa)
        p1  (list xp1 yp1)
        p2  (list xp2 yp1)
        p3  (list xp2 yp2)
        p4  (list xp1 yp2)
        p5  (list (- x1 (- absolt (* absol 0.3))) yp3)
        p6  (list xp3 yp3)
        p7  (list xp3 (- yp2 (* absol 0.3)))
        ) ;_ end of setq
  (setq neu_lay (cdr (assoc 8 (entget textobj))))
  (setvar "clayer" neu_lay)
  (setvar "cecolor" "250")
  (setvar "plinewid" ab)
  (command "._PLINE" p5 p6 p7 "")
  (setvar "cecolor" "BYLAYER")
  (setvar "celtype" "continuous")
  (setvar "plinegen" 1)
  (setvar "plinewid" 0)
  (command "._PLINE" p1 p2 p3 p4 "_cl")
  (altsv)
  (princ)
  ) ;_ end of defun
(prompt "\nTextzeilenumrandung Friedrich: mit 'TZU' aufrufen! ")
;|«Visual LISP© Format Options»
(72 2 40 1 T "end of " 60 9 0 0 0 nil T nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;