home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / TXH.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  3.3 KB  |  97 lines
  1. (vmon)
  2.  
  3. (defun txherr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (command "text" "s" "hz")
  9.    (command)
  10.    (setvar "cmdecho" 1)
  11.    (setvar "orthomode" 0)
  12.    (setq *error* oer)
  13.    (princ)
  14. )
  15.  
  16. (defun C:TXH(/ loop hgt oer sn ss ssl en sn1 d1 d2 sp sp1 sp2 iang ang a dang ename elay n insp xh rn wlist)
  17.    (setvar "cmdecho" 0)
  18.    (setq loop t hgt (* 3 (getvar "userr1")))
  19.    (setq oer *error* *error* txherr)
  20.    (command "text" "s" "standard")
  21.    (command)
  22.    (while loop
  23.    (setq sn (entsel "\n╤í╘±▓╬╒╒├┼┤░:"))
  24.    (setq en (entget (car sn)) ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  25.    (if (and (= "INSERT" ename) (= "PWINDOW" elay)) (progn
  26.        (setq insp (cdr (assoc 10 en)) iang (cdr (assoc 50 en)) sn1 (entnext (car sn)))
  27.        (setq a (/ (* 180.0 iang) pi) rn (cdr (assoc 1 (entget sn1))))
  28.        (strdv rn)
  29.        (setq xh (nth 0 wlist))
  30.        (setvar "orthomode" 1)
  31.        (setq sp (getpoint insp "\n├┼┤░╨═║┼▒Ω╫ó╡π:"))
  32.        (setq d1 (distance insp sp) ang (angle insp sp) dang (- ang iang))
  33.            (if (and (> a 90) (<= a 270)) (setq ang1 iang ang2 (+ pi iang) a (+ 180 a)) (setq ang1 (+ pi iang) ang2 iang))
  34.        (command "layer" "m" "pwindow" "")
  35.        (if (> (strlen xh) 3) (progn
  36.            (setq d2 (/ (* 3 hgt) 2.0))
  37.            (setq sp1 (polar sp ang1 d2) sp2 (polar sp ang2 d2))
  38.            (command "text" "f" sp1 sp2 hgt xh)
  39.            )
  40.            (command "text" "c" sp hgt a xh))
  41.        (setq loop nil)
  42.     ))
  43.     )
  44.    (setq ss (ssget))
  45.    (if ss (progn
  46.        (setq ssl (sslength ss) n 0)
  47.        (repeat ssl
  48.        (setq sn (ssname ss n) en (entget sn) ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  49.        (if (and (= "INSERT" ename) (= "PWINDOW" elay)) (progn
  50.        (setq insp (cdr (assoc 10 en)) iang (cdr (assoc 50 en)))
  51.        (setq sp (polar insp (+ iang dang) d1) a (/ (* 180.0 iang) pi))
  52.        (setq rn (cdr (assoc 1 (entget (entnext sn)))))
  53.        (strdv rn)
  54.        (setq xh (nth 0 wlist))
  55.            (if (and (> a 90) (<= a 270)) (setq ang1 iang ang2 (+ pi iang) a (+ a 180)) (setq ang1 (+ pi iang) ang2 iang))
  56.        (if (> (strlen xh) 4) (progn
  57.            (setq sp1 (polar sp ang1 d2) sp2 (polar sp ang2 d2))
  58.            (command "text" "f" sp1 sp2 hgt xh)
  59.            )
  60.            (command "text" "c" sp hgt a xh))
  61.       )) ;endif
  62.       (setq n (1+ n))
  63.       )
  64.       )) ;endif ss
  65.    (command "text" "s" "hz")
  66.    (command)
  67.    (command "layer" "s" "0" "")
  68.    (setvar "cmdecho" 1)
  69.    (setvar "orthomode" 0)
  70.    (setq *error* oer)
  71.    (princ)
  72. )
  73.  
  74. (defun strdv(rn / loop l x)
  75.        (setq wlist nil loop t)
  76.        (while loop
  77.           (setq l (instr 1 rn " "))
  78.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  79.              (progn ;else
  80.              (setq x (substr rn 1 (1- l)))
  81.              (setq wlist (cons x wlist))
  82.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  83.              (setq loop t)
  84.              )
  85.           )
  86.        )
  87.        (setq wlist (reverse wlist))
  88. )
  89. (defun instr(st s0 s00 / l n loop x n0 l0)
  90.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  91.    (while (and (<= n l) loop)
  92.       (setq x (substr s0 n0 1))
  93.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  94.    )
  95.    (eval l0)
  96. )
  97.