home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / WINDOW.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  6.6 KB  |  202 lines
  1. (vmon)
  2.  
  3. (defun werr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:") s)
  6.    )
  7.    (setvar "cmdecho" 1)
  8.    (setq *error* oer)
  9.    (princ)
  10. )
  11.  
  12. (defun C:DIRT(/ oer loop sn en bn ename)
  13.     (setvar "cmdecho" 0)
  14.     (setq oer *error* *error* werr)
  15.     (setq loop t)
  16.     (while loop
  17.        (setq sn (entsel "\n╤í╘±╥¬╕─▒Σ┐¬╞⌠╖╜╧≥╡─├┼┤░: "))
  18.        (if sn (progn
  19.               (setq en (entget (car sn)) ename (cdr (assoc 0 en)) bn (cdr (assoc 2 en)))
  20.               (if (and (= ename "INSERT") (or (= (substr bn 1 1) "M") (= (substr bn 1 1) "C")))
  21.                   (progn
  22.                   (setq en (subst (cons 42 (* -1 (cdr (assoc 42 en)))) (assoc 42 en) en))
  23.                   (entmod en)
  24.                   )
  25.                   (princ "\n**╤í╘±╡─╩╡╠σ▓╗╩╟├┼┤░!")
  26.                )
  27.                )
  28.                (setq loop nil)
  29.         )
  30.      )
  31.    (setvar "cmdecho" 1)
  32.    (setq *error* oer)
  33.    (princ)
  34. )
  35.  
  36. (defun C:FIX(/ oer sn en ename bn p)
  37.    (setvar "cmdecho" 0)
  38.    (setq oer *error* *error* werr)
  39.     (setq loop t)
  40.     (while loop
  41.        (setq sn (entsel "\n╤í╘±╥¬╕─▒Σ├┼╓ß╬╗╓├╡─├┼┤░: "))
  42.        (if sn (progn
  43.               (setq en (entget (car sn)) ename (cdr (assoc 0 en)) bn (cdr (assoc 2 en)))
  44.               (if (and (= ename "INSERT") (or (= (substr bn 1 1) "M") (= (substr bn 1 1) "C")))
  45.                   (progn
  46.                   (setq en (subst (cons 41 (* -1 (cdr (assoc 41 en)))) (assoc 41 en) en))
  47.                   (entmod en)
  48.                   (initget "Yes")
  49.                   (setq p (getpoint "\n╕─▒Σ┐¬╞⌠╖╜╧≥ <N>:"))
  50.                   (if p (progn
  51.                   (setq en (subst (cons 42 (* -1 (cdr (assoc 42 en)))) (assoc 42 en) en))
  52.                   (entmod en)
  53.                   )) 
  54.                   )
  55.                   (princ "\n**╤í╘±╡─╩╡╠σ▓╗╩╟├┼┤░!")
  56.                )
  57.                )
  58.                (setq loop nil)
  59.         )
  60.      )
  61.    (setvar "cmdecho" 1)
  62.    (setq *error* oer)
  63.    (princ)
  64. )
  65.  
  66. (defun C:CALC(/ oer fn name ss ssl sn en ename elay n rn wlist wn ww wh f one wl dl)
  67.    (setvar "cmdecho" 0)
  68.    (setq oer *error* *error* werr)
  69.   (setq loop t)
  70.   (while loop
  71.    (setq name (getstring "\╩Σ╚δ▓π├√ <1>:"))
  72.    (if (= name "") (setq name "1"))
  73.    (if (findfile (strcat name ".dat")) (progn
  74.    (princ (strcat "** " name " ▓π├┼┤░▒φ╥╤┤µ╘┌, ╓╪╨┤┬≡ <N>"))
  75.    (initget "Yes No")
  76.    (setq kw (getkword))
  77.    (if (= kw "Yes") (setq loop nil))
  78.    ) (setq loop nil))
  79.    ) ;while
  80.    (setq ss (ssget))
  81.    (if ss (progn
  82.    (setq wl nil dl nil ssl (sslength ss) n 0)
  83.    (repeat ssl
  84.       (setq sn (ssname ss n) en (entget sn))
  85.       (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  86.       (if (and (= "INSERT" ename) (= "PWINDOW" elay)) (progn
  87.       (setq rn (cdr (assoc 1 (entget (entnext sn)))))
  88.       (strdv rn) (setq one wlist)
  89.       (setq wn (nth 0 one) ww (nth 1 one) wh (nth 2 one))
  90.       (if (= (substr wn 1 1) "C")
  91.       (if (setq one (assoc wn wl)) (setq wl (subst (list (car one) (cadr one) (1+ (last one))) one wl))
  92.           (setq wl (cons (list wn (strcat ww "x" wh) 1) wl)))
  93.       (if (setq one (assoc wn dl)) (setq dl (subst (list (car one) (cadr one) (1+ (last one))) one dl))
  94.           (setq dl (cons (list wn (strcat ww "x" wh) 1) dl)))
  95.       )
  96.       )) ;endif "Insert"
  97.       (setq n (1+ n))
  98.    )
  99.    ))
  100.    (princ "╒²╘┌╨┤╬─╝■......╟δ╔╘║≥")
  101.    (setq f (open (strcat name ".dat") "w"))
  102.    (setq n 0 l (length wl))
  103.    (repeat l
  104.       (setq one (nth n wl))
  105.       (write-line (strcat (car one) " " (cadr one) " " (itoa (last one))) f)
  106.       (setq n (1+ n))
  107.    )
  108.    (setq n 0 l (length dl))
  109.    (repeat l
  110.       (setq one (nth n dl))
  111.       (write-line (strcat (car one) " " (cadr one) " " (itoa (last one))) f)
  112.       (setq n (1+ n))
  113.    )
  114.    (close f)
  115.    (setvar "cmdecho" 1)
  116.    (setq *error* oer)
  117.    (princ)  
  118. ) 
  119.  
  120. (defun C:MCB(/ oer sn en p wl dl f one rn wlist o1 o2 o3 n l)
  121.    (setvar "cmdecho" 0)
  122.    (setq oer *error* *error* werr)
  123.    (setq fn (getstring "\n╩Σ╚δ╕≈▓π├√ <1>:"))
  124.    (if (= fn "") (setq fn "1"))
  125.    (strdv0 fn) (setq ll (length wlist) fn wlist)
  126.    (command "insert" "mcb" "x" blx "y" blx "r" 0 pause)
  127.    (setq sn (entlast) en (entget sn))
  128.    (setq p (cdr (assoc 10 en)) wl nil dl nil n0 0)
  129.    (repeat ll
  130.    (setq f (open (strcat (nth n0 fn) ".dat") "r"))
  131.    (while (/= (setq rn (read-line f)) nil)
  132.       (strdv rn) (setq one wlist)
  133.       (setq o1 (car one) o2 (cadr one) o3 (atoi (last one)))
  134.       (if (/= (substr o1 1 2) "**") (progn
  135.       (if (= (substr o1 1 1) "C")
  136.       (if (setq one (assoc o1 wl)) (setq wl (subst (list o1 o2 (+ o3 (last one))) one wl))
  137.           (setq wl (cons (list o1 o2 o3) wl)))
  138.       (if (setq one (assoc o1 dl)) (setq dl (subst (list o1 o2 (+ o3 (last one))) one dl))
  139.           (setq dl (cons (list o1 o2 o3) dl)))
  140.       )))
  141.    )
  142.    (close f)
  143.    (setq n0 (1+ n0))
  144.    )
  145.    (setq n 0 l (length wl) p (polar p -1.57079 (* 1700 blx)))
  146.    (repeat l
  147.       (setq one (nth n wl) o1 (car one) o2 (cadr one) o3 (itoa (last one)))
  148.       (command "insert" "mcb0" (list (car p) (- (cadr p) (* n 700 blx)) (last p)) blx blx 0 o1 o2 o3)
  149.       (setq n (1+ n))
  150.    )
  151.    (setq l (length dl) p (polar p -1.57079 (* n 700 blx)) n 0)
  152.    (repeat l
  153.       (setq one (nth n dl) o1 (car one) o2 (cadr one) o3 (itoa (last one)))
  154.       (command "insert" "mcb0" (list (car p) (+ (cadr p) (* n 700 blx)) (last p)) blx blx 0 o1 o2 o3)
  155.       (setq n (1+ n))
  156.    )
  157.    (setvar "cmdecho" 1)
  158.    (setq *error* oer)
  159.    (princ)
  160. )
  161.  
  162. (defun strdv(rn / loop l x)
  163.        (setq wlist nil loop t)
  164.        (while loop
  165.           (setq l (instr 1 rn " "))
  166.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  167.              (progn ;else
  168.              (setq x (substr rn 1 (1- l)))
  169.              (setq wlist (cons x wlist))
  170.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  171.              (setq loop t)
  172.              )
  173.           )
  174.        )
  175.        (setq wlist (reverse wlist))
  176. )
  177.  
  178. (defun strdv0(rn / loop l x)
  179.        (setq wlist nil loop t)
  180.        (while loop
  181.           (setq l (instr 1 rn ","))
  182.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  183.              (progn ;else
  184.              (setq x (substr rn 1 (1- l)))
  185.              (setq wlist (cons x wlist))
  186.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  187.              (setq loop t)
  188.              )
  189.           )
  190.        )
  191.        (setq wlist (reverse wlist))
  192. )
  193.  
  194. (defun instr(st s0 s00 / l n loop x n0 l0)
  195.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  196.    (while (and (<= n l) loop)
  197.       (setq x (substr s0 n0 1))
  198.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  199.    )
  200.    (eval l0)
  201. )
  202.