home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / DWALL.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  4.2 KB  |  112 lines
  1. (vmon)
  2.  
  3. (defun dwaerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (setvar "cmdecho" 1)
  9.    (setvar "blipmode" 1)
  10.    (setvar "pickbox" pib)
  11.    (setq *error* oer)
  12.    (princ)
  13. )
  14.  
  15. (setq w 370)
  16.  
  17. (defun C:DWALL(/ pib w1 x ang a1 a2 a3 p1 p2 p insp oer ss sn en ename elay intp p3 p4 p5 p6)
  18.    (setvar "cmdecho" 0)
  19.    (setvar "blipmode" 0)
  20.    (setq pib (getvar "pickbox"))
  21.    (setq oer *error* *error* dwaerr)
  22.    (princ "\n╟╜╢Γ┐φ╢╚ <")
  23.    (princ w)
  24.    (setq x (getint ">:"))
  25.    (if (/= x nil) (setq w x))
  26.    (setq insp (getpoint "\n▓σ╚δ╡π:"))
  27.    (setq p (getpoint insp "\n╟╜╢Γ╖╜╧≥:"))
  28.    (setq ang (angle insp p) p (polar insp ang 250))
  29.    (setq ss (ssget "C" insp p))
  30.    (if ss (progn
  31.    (setq ssl (sslength ss) n 0)
  32.    (repeat ssl
  33.    (setq sn (ssname ss n) en (entget sn) ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  34.    (if (and (= "LINE" ename) (= "PWALL" (substr elay 1 5))) (progn
  35.    (setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)))
  36.    (setq intp (inters p1 p2 insp p nil))
  37.    (setq w1 (getdist intp "\n╟╜╢Γ│ñ╢╚ <500>:"))
  38.    (if (= w1 nil) (setq w1 500))
  39.    (setq p (polar intp ang w1))
  40.    (setq a1 (- ang 1.57079) a2 (+ ang 1.57079))
  41.    (setq p3 (polar intp a1 (/ w 2.0)) p4 (polar p a1 (/ w 2.0)))
  42.    (setq p5 (polar p a2 (/ w 2.0)) p6 (polar intp a2 (/ w 2.0)))
  43.    (setq p6 (inters p1 p2 p5 p6 nil) p3 (inters p1 p2 p4 p3 nil))
  44.    (command "break" sn p3 p6)
  45.    (command "layer" "m" elay "")
  46.    (command "line" p3 p4 p5 p6 "")
  47.    )) ;endif
  48.    (setq n (1+ n))
  49.    )
  50.    )) ;endif sn
  51.    (command "layer" "s" "0" "")
  52.    (setvar "blipmode" 1)
  53.    (setvar "cmdecho" 1)
  54.    (setq *error* oer)
  55.    (princ)
  56. )
  57.  
  58. (defun C:ERWALL(/ sn sn1 en en1 pib p10 p11 p20 p21 p30 p31 ang ang1 lp loop p1 p2 ename elay)
  59.    (setvar "cmdecho" 0)
  60.    (setq pib (getvar "pickbox"))
  61.    (setq oer *error* *error* dwaerr)
  62.    (setq loop t)
  63.    (while loop
  64.       (setq sn (entsel "\n╤í╘±╡┌╥╗╟╜╧▀:"))
  65.       (if sn (progn
  66.       (setq en (entget (car sn)) p1 (cadr sn))
  67.       (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  68.       (if (and (= "LINE" ename) (= "PWALL" (substr elay 1 5))) (progn
  69.       (setq lp t p10 (cdr (assoc 10 en)) p11 (cdr (assoc 11 en)) ang (angle p10 p11))
  70.       (while lp
  71.          (setq sn1 (entsel "\n╤í╘±╡┌╢■╟╜╧▀:"))
  72.         (if sn1 (progn
  73.          (setq en1 (entget (car sn1)) p2 (cadr sn1))
  74.          (setq ename (cdr (assoc 0 en1)) elay (cdr (assoc 8 en1)))
  75.          (if (and (= "LINE" ename) (= "PWALL" (substr elay 1 5))) (progn
  76.          (setq p20 (cdr (assoc 10 en1)) p21 (cdr (assoc 11 en1)) ang1 (angle p20 p21))
  77.          (if (or (equal ang (- ang1 pi) 0.1) (equal ang (+ ang1 pi) 0.1)) (progn
  78.         (if (<= (distance p1 p10) (distance p1 p11)) (setq p1 p10) (setq p1 p11))
  79.         (if (<= (distance p2 p20) (distance p2 p21)) (setq p2 p20) (setq p2 p21))
  80.         (setq p30 (polar p10 (angle p10 p11) (/ (distance p10 p11) 2.0)))
  81.         (command "break" sn "f" p1 p30)
  82.         (setq p31 (polar p20 (angle p20 p21) (/ (distance p20 p21) 2.0)))
  83.          (command "break" sn1 "f" p2 p31)
  84.          (setvar "pickbox" 1)
  85.          (setq sn (ssname (ssget p1) 0))
  86.          (if sn (progn
  87.                 (setq en (entget sn) p30 (cdr (assoc 10 en)) p31 (cdr (assoc 11 en)) ang (angle p30 p31))
  88.                 (command "erase" sn "")
  89.                 (if (>= (distance p1 p30) (distance p1 p31)) (setq p1 p30) (setq p1 p31)) )) ;if
  90.          (setq sn (ssname (ssget p2) 0))
  91.          (if sn (progn
  92.                 (setq en (entget sn) p30 (cdr (assoc 10 en)) p31 (cdr (assoc 11 en)))
  93.                 (command "erase" sn "")
  94.                 (if (>= (distance p2 p30) (distance p2 p31)) (setq p2 p30) (setq p2 p31)) )) ;if
  95.         (setq ang1 (angle p1 p2))
  96.         (setvar "pickbox" pib)
  97.         (command "layer" "m" "pwalln" "")
  98.         (if (equal ang ang1 0.1) (command "line" p1 p2 "") (command "line" p2 p1 ""))
  99.         (setq lp nil loop nil)
  100.         ) (princ "**┴╜╟╜╧▀▓╗╞Ñ┼Σ**"))
  101.         ) (princ "**▓╗╩╟╟╜╧▀**"))
  102.         )(setq lp nil loop nil))
  103.      ) ;while
  104.      ) (princ "**▓╗╩╟╟╜╧▀**"))
  105.      )(setq loop nil))
  106.      ) ;while
  107.      (command "layer" "s" "0" "")
  108.      (setvar "cmdecho" 1)
  109.      (setq *error* oer)
  110.      (princ)
  111. )
  112.