home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / TWIN.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  3.6 KB  |  106 lines
  1. (vmon)
  2.  
  3. (defun twerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command)
  8.    (command "layer" "s" "0" "")
  9.    (command "text" "s" "hz")
  10.    (command)
  11.    (setvar "cmdecho" 1)
  12.    (setvar "orthomode" 0)
  13.    (setvar "dimrnd" 0)
  14.    (setq *error* oer)
  15.    (princ)
  16. )
  17.  
  18. (defun C:TWIN(/ oer sp ep mp pl pld pll ss ssl sn en ename elay insp iang rn wlist wlength p1 p2 p3 p4 int1 int2 m n l dmax)
  19.    (setvar "cmdecho" 0)
  20.    (setvar "orthomode" 1)
  21.    (setq oer *error* *error* twerr)
  22.    (setq sp (getpoint "\n▒Ω╫ó╞≡╡π:"))
  23.    (setq ep (getpoint sp "\n▒Ω╫ó╓╒╡π:"))
  24.    (setq mp (getpoint "\n│▀┤τ╧▀╬╗╓├:"))
  25.    (setvar "orthomode" 0)
  26.    (setq ss (ssget) pl nil pld nil pll nil)
  27.    (if ss (progn
  28.    (setq ssl (sslength ss) n 0)
  29.    (repeat ssl
  30.       (setq sn (ssname ss n) en (entget sn))
  31.       (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  32.       (if (and (= "PWINDOW" elay) (= "INSERT" ename)) (progn
  33.       (setq insp (cdr (assoc 10 en)) iang (cdr (assoc 50 en)))
  34.       (setq rn (cdr (assoc 1 (entget (entnext sn)))))
  35.       (strdv rn)
  36.       (setq wlength (atoi (nth 1 wlist)))
  37.       (setq p1 (polar insp (+ pi iang) (/ wlength 2.0)))
  38.       (setq p2 (polar insp iang (/ wlength 2.0)))
  39.       (setq p3 (polar p1 (+ 1.57079 iang) 50) p4 (polar p2 (+ 1.57079 iang) 50))
  40.       (setq int1 (inters sp ep p1 p3 nil) int2 (inters sp ep p2 p4 nil))
  41.       (if (and int1 (not (member int1 pl))) (setq pl (cons int1 pl) pld (cons (distance sp int1) pld)))
  42.       (if (and int2 (not (member int2 pl))) (setq pl (cons int2 pl) pld (cons (distance sp int2) pld)))
  43.       ) ;endprogn "WINDOW"
  44.       (if (and (= "LINE" ename) (member elay '("PDIM" "PAXIS")))
  45.       (progn
  46.           (setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)))
  47.           (setq int1 (inters sp ep p1 p2 nil))
  48.           (if (and int1 (not (member int1 pl))) (setq pl (cons int1 pl) pld (cons (distance sp int1) pld)))
  49.       )));endif
  50.       (setq n (1+ n))
  51.    )
  52.    (setq l (length pl) n 0)
  53.    (repeat l
  54.       (setq dmax (apply 'max pld))
  55.       (setq m 0)
  56.       (while (< m l)
  57.         (if (= dmax (nth m pld)) (setq pll (cons (nth m pl) pll) pld (subst -1 dmax pld)) (setq m (1+ m)))
  58.       )
  59.    )
  60.    )) ;endif ss
  61.    (setq pll (cons sp pll) pll (reverse (cons ep (reverse pll))))
  62.    (command "color" "bylayer")
  63.    (command "layer" "m" "pdim" "c" "3" "pdim" "")
  64.    (command "dim" "style" "standard" "dimrnd" "10")
  65.    (setq l (length pll) n 1 p1 (nth 0 pll))
  66.    (repeat (- l 1)
  67.       (setq p2 (nth n pll))
  68.       (if (>= (distance p1 p2) 120) (progn
  69.       (if (= n 1) (progn
  70.           (command "rotate" (/ (* 180.0 (angle sp ep)) pi) p1 p2 mp "")
  71.           )
  72.           (command "continue" p2 "")
  73.       )
  74.       )) ;endif
  75.       (setq n (1+ n) p1 p2)
  76.    )
  77.    (command "dimrnd" "0" "style" "hz" "exit")
  78.    (command "layer" "s" "0" "")
  79.    (setvar "cmdecho" 1)
  80.    (setq *error* oer)
  81.    (princ)
  82. )
  83. (defun strdv(rn / loop l x)
  84.        (setq wlist nil loop t)
  85.        (while loop
  86.           (setq l (instr 1 rn " "))
  87.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  88.              (progn ;else
  89.              (setq x (substr rn 1 (1- l)))
  90.              (setq wlist (cons x wlist))
  91.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  92.              (setq loop t)
  93.              )
  94.           )
  95.        )
  96.        (setq wlist (reverse wlist))
  97. )
  98. (defun instr(st s0 s00 / l n loop x n0 l0)
  99.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  100.    (while (and (<= n l) loop)
  101.       (setq x (substr s0 n0 1))
  102.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  103.    )
  104.    (eval l0)
  105. )
  106.