home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / DIMWALL.LSP < prev    next >
Encoding:
Text File  |  1992-02-10  |  23.0 KB  |  584 lines
  1. (VMON)
  2.  
  3. (defun wallerr(s)
  4.   (if (/= s "Function cancelled")
  5.       (princ (strcat "\nError:" s))
  6.   )
  7.   (command "undo" "end")
  8.   (setvar "osmode" 0)
  9.   (setvar "aperture" apt)
  10.   (setvar "pickbox" pib)
  11.   (command "layer" "s" "0" "")
  12.   (setvar "cmdecho" 1)
  13.   (setq *error* oer)
  14.   (princ)
  15. )
  16.  
  17. (setq whgt "900" wmes "N" w 370 sd 250 d4 (* bl 15)) ;d4=dim3
  18.  
  19. (defun instr(st s0 s00 / l n loop x n0 l0)
  20.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  21.    (while (and (<= n l) loop)
  22.       (setq x (substr s0 n0 1))
  23.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  24.    )
  25.    (eval l0)
  26. )
  27.  
  28. (defun strdv(rn / loop l x)
  29.        (setq wlist nil loop t)
  30.        (while loop
  31.           (setq l (instr 1 rn " "))
  32.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  33.              (progn ;else
  34.              (setq x (substr rn 1 (1- l)))
  35.              (setq wlist (cons x wlist))
  36.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  37.              (setq loop t)
  38.              )
  39.           )
  40.        )
  41.        (setq wlist (reverse wlist))
  42. )
  43.  
  44. (defun chka(dc / l0 cm xh dst)
  45.    (if (> (instr 1 wmes ",") 0) (setq cm t) (setq cm nil))
  46.    (if (> (setq l0 (instr 1 dc "@")) 1) (progn
  47.    (setq xh (substr dc 1 (- l0 1)) dst (abs (atof (substr dc (+ l0 1)))))
  48.    (if (not cm) (if (and (assoc xh mclist) (>= dst 0)) (setq fgerr nil)) (if (and (assoc xh mclist) (>= dst 0) (/= l0 (strlen dc))) (setq fgerr nil)))
  49.    ))
  50. )
  51. (defun inwin(dsc / wn lop l x fgerr)
  52.    (setq wn 0 wl nil lop t)
  53.    (if (= wmes "N") (setq lop nil fg nil))
  54.    (while lop
  55.    (setq l (instr 1 dsc ",") fgerr t)
  56.    (if (= l 0) (progn
  57.                (chka dsc)
  58.                (if (not fgerr) (setq wl (cons dsc wl) wn (1+ wn) fg nil lop nil wl (cons wn (reverse wl)))(progn (setq lop nil) (princ "*├┼┤░╨┼╧ó╙╨┤φ*")))
  59.                )
  60.        (progn ;else
  61.        (setq x (substr dsc 1 (- l 1)))
  62.        (chka x)
  63.        (if (not fgerr) (progn
  64.        (setq wl (cons x wl) wn (1+ wn))
  65.        (setq dsc (substr dsc (+ l 1)))
  66.        )(progn (setq lop nil) (princ "*├┼┤░╨┼╧ó╙╨┤φ*")))
  67.        )
  68.    )
  69.    )
  70. )
  71.  
  72.  
  73. (defun chkmc(c / l0 l1 l2 xh wd hgt ch)
  74.    (setq wlt nil)
  75.    (if (and (> (setq l0 (instr 1 c "=")) 0) (> (setq l1 (instr 1 c "*")) 0) (> l1 l0) (= (instr 1 c "@") 0)) (progn
  76.    (setq xh (substr c 1 (- l0 1)) wd (substr c (+ l0 1) (- l1 l0 1)) hgt (substr c (+ l1 1)))
  77.    (if (and (findfile (strcat xh ".dwg"))(> (atoi wd) 0) (> (atoi hgt) 0) (> (strlen c) l1))(setq lop nil wlt (list xh wd hgt)) (princ "*├┼┤░╩²╛▌╙╨┤φ*"))) (princ "*├┼┤░╩²╛▌│÷┤φ*"))
  78. )
  79.  
  80. (defun dv(/ fg x loop xh one one0 o1 o2 o3 o4 mc wlt lop n n0 l wl wn)
  81.    (setq loop t)
  82.    (while loop
  83.    (princ "\n┴╨▒φ?/╫░╚δL/┤µ┼╠S/╘∞▒φM/┤░╠¿╕▀H/╗╪═╦U/├┼┤░╨┼╧ó\n╚▒╩í <")
  84.    (princ wmes)
  85.    (initget "? U M")
  86.    (setq x (strcase (getstring ">:")))
  87.    (if (eq x "") (setq wmes wmes) (setq wmes x))
  88.    (cond ((= wmes "U") (setq loop nil wmes "N"))
  89.         ((= wmes "H") (princ "\n┤░╠¿╕▀ <")
  90.                       (princ whgt)
  91.                       (setq x (getstring ">: "))
  92.                       (if (/= x "") (setq whgt x)) )
  93.         ((= wmes "L") (setq lop t)
  94.                       (while lop
  95.                       (setq fnm (getstring "\n╬─╝■├√: "))
  96.                       (if (findfile (strcat fnm ".mc")) (progn
  97.                       (setq mclist nil)
  98.                       (setq f (open (strcat fnm ".mc") "r"))
  99.                       (while (/= (setq rn (read-line f)) nil)
  100.                          (strdv rn)
  101.                          (setq mclist (cons wlist mclist))
  102.                       )
  103.                     (close f)
  104.                       (setq lop nil))
  105.                       (princ "**╬─╝■├╗╒╥╡╜!**"))
  106.                       ))
  107.          ((= wmes "S") (setq lop t)
  108.                        (while lop
  109.                        (setq fnm (getstring "\n╬─╝■├√: "))
  110.                        (if (findfile (strcat fnm ".mc")) (progn
  111.                        (initget "Y N")
  112.                        (setq x (getkword "**╬─╝■╥╤┤µ╘┌, ╓╪╨┤┬≡ <N>**"))
  113.                        ) (setq x "Y"))
  114.                       (if (= x "Y") (progn
  115.                        (setq f (open (strcat fnm ".mc") "w"))
  116.                        (setq n 0 l (length mclist))
  117.                        (repeat l
  118.                          (setq one (nth n mclist))
  119.                          (write-line (strcat (nth 0 one) " " (nth 1 one) " " (nth 2 one) " " (nth 3 one)) f)
  120.                          (setq n (1+ n))
  121.                       )
  122.                       (close f)
  123.                       (setq lop nil)
  124.                       ))
  125.                       ) )
  126.          ((= wmes "M") (princ "\n├┼┤░╨═║┼ <C-1>:")
  127.                        (setq x (strcase (getstring)))
  128.                        (if (= x "") (setq xh "C-1") (setq xh x))
  129.                        (if (setq one (assoc xh mclist)) (progn
  130.                        (setq lop t)
  131.                        (while lop
  132.                        (princ "\n├┼┤░╩²╛▌ <")
  133.                        (setq one0 (cdr one) o1 (nth 0 one0) o2 (nth 1 one0) o3 (nth 2 one0))
  134.                        (princ (setq mc (strcat (strcase o1) "=" o2 "*" o3)))
  135.                        (setq x (strcase (getstring ">:")))
  136.                        (if (= x "") (setq mc mc) (setq mc x))
  137.                        (chkmc mc)
  138.                       )
  139.                       (setq mclist (subst (cons xh wlt) one mclist))
  140.                       )
  141.                       (progn ;else
  142.                       (setq lop t)
  143.                       (while lop
  144.                       (while (= (setq x (strcase (getstring "\n├┼┤░╩²╛▌:"))) ""))
  145.                       (chkmc x))
  146.                       (setq mclist (cons (cons xh wlt) mclist))
  147.                       )
  148.                       ) ;endif
  149.                      ) ;end cond1
  150.          ((= wmes "?") (setq l (length mclist) n 0)
  151.                        (setq wmes "N")
  152.                        (if (> l 0) (progn
  153.                        (princ "\n**╨═║┼ ┐Θ├√ ┐φ╢╚ ╕▀╢╚ **")
  154.                        (repeat l
  155.                           (setq x (nth n mclist))
  156.                           (princ "\n   ")
  157.                           (setq n0 0)(repeat (length x) (princ (read (nth n0 x))) (princ " ") (setq n0 (1+ n0)))
  158.                           (setq n (1+ n))
  159.                        ))
  160.                       (princ "\n*├┼┤░▒φ╓╨╬▐╩²╛▌*")
  161.                       ))
  162.          (t (setq fg t) (inwin wmes) (if (= fg nil) (progn (dv0) (setq loop nil))))
  163.          )
  164.    )
  165. )
  166.  
  167. (defun dv0(/ wn n n0 n1 zdist idx x x1 l0 l1 l2 wname wlength whight wdist inswfg wnl one mode pl right)
  168.    (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  169.    (setq pl nil wnl nil inswfg nil)
  170.    (if (not (or (eq wmes "N") (eq wmes "n")))
  171.    (progn
  172.    (setq wn (+ (* (setq n (car wl)) 2) 1) n0 1)
  173. ;  (setq pl (cons wn pl) pl (cons a pl))
  174.    (setq zdist 0 right nil)
  175.    (repeat n
  176.       (setq x (nth n0 wl))
  177.       (setq idx (substr x 1 (- (setq l0 (instr 1 x "@")) 1)))
  178.       (setq one (assoc idx mclist) x1 (cdr one))
  179.       (setq wname (nth 0 x1) wlength (atof (nth 1 x1)) whight (nth 2 x1))
  180.       (setq wdist (atof (substr x (1+ l0))) wnl (cons (list idx wname whight) wnl))
  181.       (if (and (= n0 1) (< wdist 0)) (setq right T))
  182.       (setq wdist (abs wdist))
  183.       (if (and (= l0 (strlen x)) (= wdist 0)) (setq wdist (- (/ (distance a b) 2) (/ wlength 2))))
  184.       (if (not right) (progn
  185.       (setq p (polar a (setq ang (angle a b)) (+ zdist wdist)) pl (cons p pl))
  186.       (setq p (polar a ang (setq zdist (+ zdist wdist wlength))) pl (cons p pl))
  187.       )(progn
  188.       (setq ang (angle a b))
  189.       (setq p (polar b (angle b a) (+ zdist wdist)) pl (cons p pl))
  190.       (setq p (polar b (angle b a) (setq zdist (+ zdist wdist wlength))) pl (cons p pl))
  191.       ))
  192.       (setq n0 (1+ n0))
  193.    )
  194.    (if (not right) (setq wnl (reverse wnl) pl (cons a (reverse pl)) pl (reverse (cons wn pl))) (setq pl (cons a pl) pl (reverse (cons wn pl))))
  195.       )
  196.       (progn ;else
  197.       (setq pl (cons a (cons 1 pl)))
  198.       (setq ang (angle a b))
  199.       )) ;endif
  200.    (setq pl (reverse (cons b pl)))
  201.  
  202.    (command "undo" "g")
  203.    (setq mode 0 n1 0 n0 1 n (car pl))
  204.    (repeat n
  205.       (if (= mode 0) (progn ;wall
  206.                      (setq a0 (nth n0 pl) b0 (nth (1+ n0) pl))
  207.                      (if (or (> (distance a0 b0) 0) (and (= (distance a0 b0) 0) (or (= n0 1) (= n0 n))))
  208.                      (progn
  209.                      (setq a1 (polar a0 (- ang 1.57079) dx))
  210.                      (setq b1 (polar b0 (- ang 1.57079) dx))
  211.                      (setq a2 (polar a0 (+ ang 1.57079) dy))
  212.                      (setq b2 (polar b0 (+ ang 1.57079) dy))
  213. ;;                   (command "layer" "m" "pwall" "")
  214.                      (if (and (= n0 1) (= bgn 1))
  215.                          (progn
  216.                                 (if (> n 1) (dim))
  217.                                 (if brkw (progn
  218.                          (setq ss (ssget "C" a0 (polar a0 ang 200)))
  219.                          (if ss (progn
  220.                          (setq ssl (sslength ss) nc 0 loop t)
  221.                          (while (and (< nc ssl) loop)
  222.                            (setq en (entget (setq sn (ssname ss nc))))
  223.                            (if (and (= "LINE" (cdr (assoc 0 en))) (= "PWALL" (substr (cdr (assoc 8 en)) 1 5))) (progn
  224.              (setq ac (cdr (assoc 10 en)) bc (cdr (assoc 11 en)))
  225.              (if (and (not (= (angle ac bc) ang)) (not (= (angle ac bc) (+ (angle ac bc) pi)))) (progn
  226.              (setq a1 (inters a1 b1 ac bc nil) a2 (inters a2 b2 ac bc nil))
  227.              (command "break" sn a1 a2)
  228.              (setq loop nil)
  229.              )) ;endif
  230.              )) ;endif
  231.                       (setq nc (1+ nc))
  232.                       ) ;endwhile
  233.                       )) ;endif
  234.                                  )) ;endif brkw
  235.                                  (drline part a1 b1)(setq ent1 (entlast))
  236.                                  (drline nil a2 b2)(setq ent2 (entlast))
  237.                                  (setq ai4 a2 ai3 a1 ai2 b2 ai1 b1 a00 a b00 b)
  238.                                  (setq bgn 0)
  239.                                  (if (eq n 1) (setq wf t)))
  240.                         (progn ;else
  241.                         (if (= n0 1)
  242.                         (progn
  243.                         (setq ab1 (inters a1 b1 a3 b3 nil))
  244.                         (setq ab2 (inters a2 b2 a4 b4 nil))
  245.                         (if (and (/= ab1 nil) (/= ab2 nil))
  246.                         (progn
  247.                         (command "erase" "l" "")
  248.                         (command "erase" "l" "")
  249.                         (drline nil a4 ab2)
  250.                         (drline part a3 ab1)
  251.                         (if (> n 1) (dim))
  252.                         (drline nil ab2 b2)(setq ent1 (entlast))
  253.                         (drline part ab1 b1)(setq ent2 (entlast))
  254.                         (setq a1 ab1 a2 ab2)
  255.                         (if wf (setq ai4 a4 ai3 a3 ai2 ab2 ai1 ab1 wf nil))
  256.                         )
  257.                         (progn ;else
  258.                         (command "erase" "l" "")
  259.                         (command "erase" "l" "")
  260.                         (if (> n 1) (dim))
  261.                         (drline part a3 b1)(setq ent1 (entlast))
  262.                         (drline nil a4 b2)(setq ent2 (entlast))
  263.                         (setq a1 a3 a2 a4 b3 b1 b4 b2)
  264.                         (if wf (setq ai1 b1 ai2 b2 wf nil))
  265.                         )
  266.                         ) ;endif
  267.                        ) ;n0=1 end then
  268.                      (progn ;n0=1 else
  269.                      (if (> n 1) (dim))
  270.                      (drline part a1 b1)(setq ent1 (entlast))
  271.                      (drline nil a2 b2)(setq ent2 (entlast))
  272.                      ) 
  273.                   ) ;bgn=1 endelse
  274.                   );endif
  275.                 
  276.                  ) ;endif
  277.                  ) (setq inswfg t)) ;endif distance>0
  278.                      (setq mode 1)
  279.                      ) ;wall endprogn
  280.       (progn ;else
  281.       (command "layer" "m" "pwindow" "")
  282.       (setq a0 (nth n0 pl) b0 (nth (1+ n0) pl) idx (car (nth n1 wnl)) wname (cadr (nth n1 wnl)) whight (nth 2 (nth n1 wnl)) n1 (1+ n1))
  283.       (setq a1 (polar a0 (- ang 1.57079) dx))
  284.       (setq b1 (polar b0 (- ang 1.57079) dx))
  285.       (setq a2 (polar a0 (+ ang 1.57079) dy))
  286.       (setq b2 (polar b0 (+ ang 1.57079) dy))
  287.       (setq insp (polar a0 ang (/ (setq ds (fix (+ (distance a0 b0) 0.5))) 2)))
  288.       (if (>= cud 0) (setq insp (polar insp (- ang 1.57079) (abs cud))) (setq insp (polar insp (+ ang 1.57079) (abs cud))))
  289.       (setq insx (/ ds 100.0) iang (/ (* ang 180) pi))
  290.       (if (or (= (substr wname 1 1) "C") (= (substr wname 1 1) "c")) (setq insy (/ w 10.0) whgt0 whgt) (setq insy insx whgt0 "0"))
  291.       (if inswfg (progn (command "erase" "l" "")))
  292.       (command "insert" wname insp "xyz" insx insy 0.01 iang (strcat idx " " (itoa ds) " " whight " " whgt0 " " (itoa w)))
  293.       (command "line" a1 a2 "")
  294.       (if inswfg (progn (command "erase" "l" "") (command "trace" 0 a1 a2 "") (setq inswfg nil)))
  295.       (command "line" b1 b2 "")
  296.       (dim)
  297.       (setq mode 0)
  298.       )
  299.       ) ;endif
  300.    (if (= n0 n) (sta))
  301.    (setq n0 (1+ n0))
  302.    )
  303.    (command "undo" "end")
  304. )
  305.  
  306. (defun drline(part a1 a2)
  307.   (if part
  308.      (command "layer" "s" "pwallw" "")
  309.      (command "layer" "s" "pwalln" "")
  310.   )
  311.   (command "line" a1 a2 "")
  312. )
  313.  
  314. (defun dim(/ a5 b5 ab5 iang)
  315.    (if dim1 (progn
  316.       (setq iang (/ (* ang 180) pi))
  317.       (setq oco (getvar "CECOLOR"))
  318.       (command "color" "bylayer")
  319.       (setq ol (getvar "CLAYER"))
  320.       (command "layer" "m" "pdim" "")
  321.       (if (= mode 0) (progn (setvar "DIMSE1" 1) (setvar "DIMSE2" 1)))
  322.       (command)
  323.       (command "dim" "style" "standard")
  324.       (cond ((eq ang 0) (setq a5 (list (car a0) (cadr ll0)))
  325.                         (setq b5 (list (car b0) (cadr ll0)))
  326.                         (setq ab5 (polar a5 (- ang 1.57079) d4))
  327.                         (command "rotated" iang a5 b5 ab5 "")
  328.                         (dimin))
  329.             ((eq ang (/ pi 2)) (setq a5 (list (car ur0) (cadr a0)))
  330.                          (setq b5 (list (car ur0) (cadr b0)))
  331.                          (setq ab5 (polar a5 (- ang 1.57079) d4))
  332.                          (command "rotated" iang a5 b5 ab5 "")
  333.                          (dimin))
  334.             ((eq ang pi) (setq a5 (list (car b0) (cadr ur0)))
  335.                          (setq b5 (list (car a0) (cadr ur0)))
  336.                          (setq ab5 (polar a5 (- ang 1.57079) d4))
  337.                          (command "rotated" iang a5 b5 ab5 "")
  338.                          (dimin))
  339.             ((eq ang (/ (* pi 3) 2))
  340.                          (setq a5 (list (car ll0) (cadr a0)))
  341.                          (setq b5 (list (car ll0) (cadr b0)))
  342.                          (setq ab5 (polar a5 (- ang 1.57079) d4))
  343.                          (command "rotated" (- iang 180) a5 b5 ab5 "")
  344.                           (dimin))
  345.       )
  346.       (command "style" "hz" "exit")
  347.       (if (= "BYLAYER" oco) (command "color" oco) (command "color" (atoi oco)))
  348.       (setvar "DIMSE1" 0) (setvar "DIMSE2" 0)
  349.       (command "layer" "s" ol "")
  350.    )) ;endif dim1
  351. )
  352.  
  353. (defun dimin(/ dist dist1 dang sn en p np)
  354.    (setq dist (distance a5 b5))
  355.    (if (< dist 600) (progn
  356.        (setq sn (ssname (ssget "L") 0) en (entget sn))
  357.        (setq p (cdr (assoc 11 en)) dang (cdr (assoc 50 en)))
  358.        (if (or (eq ang 0) (eq ang (/ pi 2))) (setq dang (+ dang 1.57079) dist1 500) (setq dang (- dang 1.57079) dist1 1100))
  359.        (setq np (polar p dang dist1))
  360.        (setq en (subst (cons 70 128) (assoc 70 en) en))
  361.        (entmod (subst (cons 11 np) (assoc 11 en) en))
  362.    ))
  363. )
  364.  
  365. (VMON)
  366.  
  367. (defun C:WALL (/ oer apt pib osm ol x ab1 ab2 a b c a00 b00 a1 a2 a3 a4 b1 b2 b3 b4 a0 b0 ai1 ai2 ai3 ai4 cud insp insx insy ang iang bgn wf n0 n1 mode hw dx dy dim1 brkw alist a3list b3list a4list b4list ent1 ent2)
  368.   (setvar "cmdecho" 0)
  369.   (setq apt (getvar "aperture"))
  370.   (setq pib (getvar "pickbox"))
  371.   (setvar "OSMODE" 0) (setq osm 0)
  372.   (command "color" "bylayer")
  373.   (setq oer *error* *error* wallerr)
  374.   (command "undo" "end")
  375.   (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  376.   (princ "\n╟╜║± <")
  377.   (princ w)
  378.   (setq x (getint ">:"))
  379.   (if (eq x nil) (setq w w) (setq w x))
  380.   (princ "\n═Γ╟╜║± <")
  381.   (princ sd)
  382.   (setq x (getint ">:"))
  383.   (if (eq x nil) (setq sd sd) (setq sd x))
  384.   (setq alist nil b3list nil a3list nil b4list nil a4list nil)
  385.   (if (null (tblsearch "layer" "pwalln")) (command "layer" "n" "pwalln" "c" 16 "pwalln" ""))
  386.   (if (null (tblsearch "layer" "pwallw")) (command "layer" "n" "pwallw" "c" 7 "pwalln" ""))
  387.   (setq part t)
  388.   (geta) ;get start point
  389.   (getb) ;get next point
  390.   (setq cud (- sd (setq hw (/ w 2))))
  391.   (if (= cud 0) (setq dx hw dy hw)
  392.       (setq dx (+ hw cud) dy (- hw cud)))
  393.   (setq bgn 1)
  394.   (setq dim1 nil brkw nil)
  395.   (setvar "OSMODE" 0) (dv) (setvar "OSMODE" osm)
  396. ; (setq a b b3 b1 a3 a1 b4 b2 a4 a2)
  397.   (getb) ;get next point
  398.   (while (/= b nil)
  399.     (setq dim1 nil brkw nil)
  400.     (setvar "OSMODE" 0) (dv) (setvar "OSMODE" osm)
  401.     (getb) ;get next point
  402.   )
  403.   (initget "Yes No")
  404.   (setq c (getkword "┴¼╜╙╫ε║≤╟╜╜╟ <Y>:"))
  405.   (if (or (= c nil) (= c "Yes")) (cln))
  406.   (command "layer" "s" "0" "")
  407.   (setvar "OSMODE" 0)
  408.   (setvar "cmdecho" 1)
  409.   (setq *error* oer)
  410.   (princ)
  411. )
  412.  
  413. (VMON)
  414.  
  415. (defun C:PARTYWALL (/ oer apt pib lp loop osm x ol ot sel1 sel2 p1 p2 p3 p4 ab1 ab2 a b c a00 b00 a1 a2 a3 a4 b1 b2 b3 b4 a0 b0 ai1 ai2 ai3 ai4 cud insp insx insy ang iang bgn wf n0 n1 mode hw dx dy dim1 brkw alist a3list b3list a4list b4list ent1 ent2)
  416.   (setvar "cmdecho" 0)
  417.   (setq apt (getvar "aperture"))
  418.   (setq pib (getvar "pickbox"))
  419.   (setvar "OSMODE" 0) (setq osm 0)
  420.   (command "color" "bylayer")
  421.   (setq oer *error* *error* wallerr)
  422.   (command "undo" "end")
  423.   (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  424.   (princ "\n╟╜║± <")
  425.   (princ w)
  426.   (setq x (getint ">:"))
  427.   (if (eq x nil) (setq w w) (setq w x))
  428.   (setq sd (/ w 2))
  429.   (if (null (tblsearch "layer" "pwalln")) (command "layer" "n" "pwalln" "c" 16 "pwalln" ""))
  430.   (setq lp t part nil)
  431.   (while lp
  432.   (setvar "OSMODE" osm)
  433.   (setq alist nil a3list nil b3list nil a4list nil b4list nil)
  434.   (geta) ;get start point
  435.   (getb) ;get next point
  436.   (setq cud (- sd (setq hw (/ w 2))))
  437.   (if (= cud 0) (setq dx hw dy hw)
  438.       (setq dx (+ hw cud) dy (- hw cud)))
  439.   (setq bgn 1)
  440.   (setq dim1 nil brkw t)
  441.   (setvar "OSMODE" 0) (dv) (setvar "OSMODE" osm)
  442. ; (setq a b b3 b1 a3 a1 b4 b2 a4 a2)
  443.   (getb) ;get next point
  444.   (while (/= b nil)
  445.     (setq dim1 nil brkw t)
  446.     (setvar "OSMODE" 0) (dv) (setvar "OSMODE" osm)
  447.     (getb) ;get next point
  448.   )
  449.     (setq ss (ssget "C" b0 (polar b0 (+ ang pi) 200)))
  450.     (if ss (progn
  451.     (setq ssl (sslength ss) nc 0 loop t)
  452.     (while (and (< nc ssl) loop)
  453.     (setq en (entget (setq sn (ssname ss nc))))
  454.     (if (and (= "LINE" (cdr (assoc 0 en))) (= "PWALL" (substr (cdr (assoc 8 en)) 1 5)) (not (eq sn ent1)) (not (eq sn ent2))) (progn
  455.     (setq ac (cdr (assoc 10 en)) bc (cdr (assoc 11 en)))
  456.     (if (and (not (= (angle ac bc) ang)) (not (= (angle ac bc) (+ ang pi)))) (progn
  457.     (setq b1 (inters a3 b3 ac bc nil) b2 (inters a4 b4 ac bc nil))
  458.     (setvar "OSMODE" 0)
  459.     (command "erase" "l" "")
  460.     (command "erase" "l" "")
  461.     (command "break" sn b1 b2)
  462.     (drline nil a3 b1)
  463.     (drline nil a4 b2)
  464.     (setq loop nil)
  465.     )) ;endif
  466.     )) ;endif
  467.     (setq nc (1+ nc))
  468.     ) ;endwhile
  469.     )) ;endif
  470.     (initget "Yes No")
  471.     (setq b1 (getkword "\n╝╠╨°╖± <Y> "))
  472.     (if (eq b1 "No") (setq lp nil))
  473.     ) ;endwhile
  474.     (command "layer" "s" "0" "")
  475.     (setvar "OSMODE" 0)
  476.     (setvar "cmdecho" 1)
  477.     (setq *error* oer)
  478.     (princ)
  479. )
  480.  
  481. (defun cln()
  482.                     (command "erase" "l" "")
  483.                     (command "erase" "l" "")
  484.                     (setq apt (getvar "APERTURE"))
  485.                     (setq pib (getvar "PICKBOX"))
  486.                     (setvar "APERTURE" 1)
  487.                     (setvar "PICKBOX" 1)
  488.                     (command "erase" (osnap ai4 "END") "")
  489.                     (command "erase" (osnap ai3 "END") "")
  490.                     (setvar "PICKBOX" pib)
  491.                     (setvar "APERTURE" apt)
  492.                     (setq ab1 (inters a1 b1 ai1 ai3 nil))
  493.                     (setq ab2 (inters a2 b2 ai2 ai4 nil))
  494.                     (if (and (/= ab1 nil) (/= ab2 nil))
  495.                     (progn
  496.                     (setvar "OSMODE" 0)
  497.                     (drline nil ab2 ai2)
  498.                     (drline part ab1 ai1)
  499.                     (drline nil a4 ab2)
  500.                     (drline part a3 ab1)
  501.                     (setvar "OSMODE" osm)
  502.                     )
  503.                     (progn
  504.                     (setvar "OSMODE" 0)
  505.                     (drline part a1 ai1)
  506.                     (drline nil a2 ai2)
  507.                     (setvar "OSMODE" osm)
  508.                     )) ;endif
  509. )
  510.  
  511. (defun geta(/ loop)
  512.   (graphscr)
  513.   (setq loop t)
  514.   (while loop
  515.   (initget 1 "R ON OFF")
  516.   (setq a (getpoint "\nR▓╬┐╝╡π/ON/OFF <╞≡╡π>:"))
  517.   (cond
  518.   (   (eq a "R") (progn
  519.                  (setq a (getpoint "\n▓╬┐╝╡π:"))
  520.                  (setq a (getpoint a "\n@X,Y ╗≥ @│ñ╢╚<╜╟╢╚:"))
  521.                  (setq loop nil)
  522.                  )) ;endif
  523.   (   (eq a "ON") (progn
  524.                   (setvar "OSMODE" 8)
  525.                   (princ "<▓╢╫╜╓ß╧▀╡π┤≥┐¬>")
  526.                   (setq loop t osm 8)
  527.                   ))
  528.   (   (eq a "OFF") (progn
  529.                    (setvar "OSMODE" 0)
  530.                    (princ "<▓╢╫╜╓ß╧▀╡π╣╪▒╒>")
  531.                    (setq loop t osm 0)
  532.                    ))
  533.   (t (setq loop nil))
  534.   ))
  535. )
  536.  
  537. (defun getb(/ loop)
  538.   (setq loop t)
  539.   (while loop
  540.   (initget "R U ON OFF")
  541.   (setq b (getpoint a "\nR▓╬┐╝╡π/U╗╪═╦/ON/OFF <╓╒╡π>:"))
  542.   (cond
  543.   (   (eq b "R") (progn
  544.                  (setq b (getpoint "\n▓╬┐╝╡π:"))
  545.                  (setq b (getpoint b "\n@X,Y ╗≥ @│ñ╢╚<╜╟╢╚:"))
  546.                  (setq loop nil)
  547.                  )) ;endif
  548.   (   (eq b "ON") (progn
  549.                   (setvar "OSMODE" 8)
  550.                   (princ "<▓╢╫╜╓ß╧▀╡π┤≥┐¬>")
  551.                   (setq loop t osm 8)
  552.                   ))
  553.   (   (eq b "OFF") (progn
  554.                    (setvar "OSMODE" 0)
  555.                    (princ "<▓╢╫╜╓ß╧▀╡π╣╪▒╒>")
  556.                    (setq loop t osm 0)
  557.                    ))
  558.   (  (eq b "U") (progn
  559.                 (if (/= alist nil) (progn
  560.                 (command "undo" "1")
  561.                 (setq a (car alist) alist (cdr alist) b3 (car b3list) b3list (cdr b3list) a3 (car a3list) a3list (cdr a3list) b4 (car b4list) b4list (cdr b4list) a4 (car a4list) a4list (cdr a4list) loop t)
  562.                 )
  563.                 (progn
  564.                 (princ "*▓╗─▄╘┘╗╪═╦*")
  565.                 (setq loop t)
  566.                 ))
  567.                 (if (= (length alist) 0) (setq bgn 1))
  568.                 ))
  569.   (t (setq loop nil))
  570.   ))
  571.   (princ)
  572. )
  573.  
  574. (defun sta()
  575.    (if (> (length alist) 9) (progn
  576.      (setq alist (reverse (cdr (reverse alist))))
  577.      (setq b3list (reverse (cdr (reverse b3list))))
  578.      (setq a3list (reverse (cdr (reverse a3list))))
  579.      (setq b4list (reverse (cdr (reverse b4list))))
  580.      (setq a4list (reverse (cdr (reverse a4list))))
  581.    ))
  582.    (setq alist (cons a alist) a b b3list (cons b3 b3list) b3 b1 a3list (cons a3 a3list) a3 a1 b4list (cons b4 b4list) b4 b2 a4list (cons a4 a4list) a4 a2)
  583. )
  584.