home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / PAO.LSP < prev    next >
Encoding:
Text File  |  1992-02-18  |  37.9 KB  |  906 lines
  1. (vmon)
  2.  
  3. (defun drl (/ a n td two b yn fd temp temp1)
  4.          (setq a 0 temp xy temp1 nil)
  5.          (setq n (length temp)) 
  6.          (while (< a n)
  7.           (if (/= (setq b (nth a temp)) 'nil)
  8.             (setq temp1 (cons b temp1) temp (subst 'nil b temp))
  9.           )
  10.           (setq a (1+ a))
  11.          )
  12.           (setq temp1 (reverse temp1) n (length temp1) a 0 b nil temp nil) 
  13.           (while (< a n)
  14.             (setq td nil two (+ cengao (cadr jd)) b (nth a temp1) fd nil)
  15.             (if (= ymin b) (progn
  16.               (setq td (cons two td) td (cons (car jd) td))
  17.              (command "PLINE" td "W" width width jd "")
  18.             (setq se (entlast))
  19.              (ssadd se ss)))
  20.             (if (= ymax b) (progn
  21.                      (setq yn (abs (- ymax ymin))) 
  22.                      (setq td (cons two td) td (cons (+ yn (car jd)) td))
  23.             (setq fd (cons (cadr jd) fd) fd (cons (+ yn (car jd)) fd))
  24.             (command "PLINE" fd "W" width width td "")
  25.             (setq se (entlast))
  26.             (ssadd se ss)))
  27.          (if (and (/= ymin b) (/= ymax b)) (progn
  28.    (setq td (cons (- two bho) td) td (cons (+ (abs (- b ymin)) (car jd)) td))
  29.      (setq fd (cons (cadr jd) fd) fd (cons (+ (abs (- b ymin))  (car jd)) fd))
  30.            (command "PLINE" fd "W" width width td "")
  31.            (setq se (entlast))
  32.            (ssadd se ss )
  33.             ))
  34.            (setq a (1+ a))
  35.         )
  36. )
  37.  
  38. (defun kx (/ a n ak nk bk1 b jdy fy fx td1 td2 kbg)  
  39.         (setq a 0 n (length lxy)  fy (cadr jd))
  40.           (while (< a n)
  41.             (setq td1 nil td2 nil kbg 1 jdy (+ cengao (cadr jd)))
  42.            (if (eq fg "Col")
  43.               (setq b (cadr (nth a lxy)))
  44.               (setq b (car (nth a lxy)))
  45.            )
  46.            (if (or (eq px "L") (eq px "U")) (progn 
  47.              (if (> b ymin)
  48.                 (setq fx (+ (car jd) (- b ymin)))
  49.                 (setq fx (abs (- (car jd) (- ymin b))))
  50.              )
  51.              (if (and (> b ymin) (< b ymax)) (setq jdy (- jdy bho))
  52.              ))
  53.            )
  54.            (if (or (eq px "R") (eq px "D")) (progn 
  55.                (if (< b ymin)
  56.                  (setq fx (+ (car jd) (abs (- b ymin))))
  57.                  (setq fx (abs (- (car jd) (- b ymin))))
  58.                )
  59.                (if (and (< b ymin) (> b ymax)) (setq jdy (- jdy bho))
  60.                ))
  61.           )
  62.           (if (= (type mlxy) 'LIST) (progn
  63.              (setq ak 0 nk (length mlxy) bk (car (nth ak mlxy)))
  64.             (while (< ak nk)
  65.               (setq bk1 (car (nth ak mlxy)) bk2 (car (nth (1+ ak) mlxy)))
  66.               (if (or (equal bk1 fx width)
  67.                       (equal bk2 fx width)
  68.                        (and (>= bk1 fx) (<= bk2 fx))
  69.                        (and (<= bk1 fx) (>= bk2 fx)))
  70.                  (setq kbg 0 ak nk))
  71.               (setq ak (+ ak 2))
  72.             )
  73.           ))             
  74.     (if (= kbg 1) (progn
  75.           (command "LAYER" "M" "SWALL" "C" "7" "" "")
  76. (setq td1 (cons fy td1) td1 (cons fx td1) td2 (cons jdy td2) td2 (cons fx td2))
  77.           (command "LINE" td1 td2 "")
  78.           (setq se (entlast))
  79.           (ssadd se ss)
  80.     ))
  81.             (setq a (1+ a))
  82.   )
  83. )  
  84.  
  85. (defun ban (/ fd1 fd2 td1 td2 jg pt1 pt2 jxs jxl temp)
  86.          (setq temp nil)
  87.          (setq temp xy)
  88.          (command "LAYER" "M" "SBAN1" "C" "7" "" "")
  89.          (setq x1 (apply 'max temp))
  90.          (setq xl (apply 'min temp))
  91.         (setq temp (subst 0.0 x1 temp))
  92.          (setq x2 (apply 'max temp))
  93.          (setq ws (abs (- x1 x2)) temp xy)
  94.          (setq temp (subst 999999.0 xl temp))
  95.          (setq xl2 (apply 'min temp))
  96.          (setq wl(abs (- xl2 xl)))
  97.        (setq fd1 nil td1 nil fd2 nil td2 nil jg (abs (- ymax ymin)))
  98.        (setq jxs (+ (car jd) ws) jxl (+ (car jd) (abs (- jg wl))))
  99.        (setq pt1 (+ cengao (cadr jd)) pt2 (- pt1 width2))
  100.        (setq fd1 nil fd2 nil td1 nil td2 nil) 
  101.        (setq fd1 (cons pt2 fd1) fd1 (cons jxs fd1) td1 (cons pt2 td1) td1 (cons jxl td1))
  102.        (command "pline" fd1 td1 "")
  103.        (setq se (entlast))
  104.        (ssadd se ss)
  105.        (command "LAYER" "M" "SBAN2" "C" "7" "" "")
  106.        (setq fd2 (cons (- pt2 bho) fd2) fd2 (cons jxs fd2) td2 (cons (- pt2 bho) td2) td2 (cons jxl td2))
  107.        (command "pline" fd2 td2 "")
  108.        (setq se (entlast))
  109.        (ssadd se ss)
  110.        (setq fd1 nil fd2 nil td1 nil td2 nil)
  111.        (setq fd1 (cons pt1 fd1) fd1 (cons jxs fd1) td1 (cons pt1 td1) td1 (cons (- jxs qw) td1)) 
  112.        (setq fd2 (cons (- pt1 qh) fd2) fd2 (cons jxs fd2) td2 (cons (- pt1 qh) td2) td2 (cons (- jxs qw) td2))
  113.        (command "solid" fd1 td1 fd2 td2 "")
  114.        (setq se (entlast))
  115.        (ssadd se ss)
  116.        (setq fd1 nil fd2 nil td1 nil td2 nil)
  117.        (setq fd1 (cons pt1 fd1) fd1 (cons jxl fd1) td1 (cons pt1 td1) td1 (cons (+ jxl qw) td1))
  118.        (setq fd2 (cons (- pt1 qh) fd2) fd2 (cons jxl fd2) td2 (cons (- pt1 qh) td2) td2 (cons (+ jxl qw) td2))
  119.        (command "solid" fd1 td1 fd2 td2 "")
  120.        (setq se (entlast))
  121.        (ssadd se ss)  
  122. )
  123.  
  124. (defun st (/ n a pt1 pt2 t1 t2 fd1 fd2 td1 td2 pmin pmax x1 x2 xy1 xy2 xy22 t1 t11 y)
  125.      (command "layer" "M" "SOTHER" "C" "7" "" "")
  126.      (setq n (length pj) a 0)
  127.      (while (< a (1- n))
  128.       (setq pt1 nil pt2 nil fd1 nil fd2 nil td1 nil td2 nil)   
  129.       (setq pt1 (nth a pj) pt2 (nth (1+ a) pj) pmax ( max pt1 pt2) pmin (min pt1 pt2))
  130.       (setq y (- (cadr jd) (* 1.5 (getvar "userr1"))))
  131.       (if (or (eq px "L") (eq px "U"))
  132.        (if (< pmax ymax)
  133. (setq x1 (abs (- ymin pmin)) x2 (abs (- ymin pmax)) t1 (car jd) xy1 (abs (- (car jd) x1)) xy2 (abs (- (car jd) x2)) xy22 (- xy2 50.0) t11 (- t1 width2) t2 (+ t1 150.0))
  134. (setq x1 (abs (- ymax pmax)) x2 (abs (- ymax pmin)) t1 (+ (car jd) (abs (- ymax ymin))) xy1 (+ t1 x1) xy2 (+ t1 x2) xy22 (+ xy2 50.0) t11 (+ t1 width2) t2 (- t1 150.0))))
  135.       (if (or (eq px "R") (eq px "D"))
  136.        (if (< pmax ymax)
  137. (setq x1 (abs (- ymax pmin)) x2 (abs (- ymax pmax)) t1 (+ (car jd) (abs (- ymax ymin))) xy1 (+ t1 x1) xy2 (+ t1 x2) xy22 (+ xy2 50.0) t11 (+ t1 width2) t2 (- t1 150.0))
  138. (setq x1 (abs (- ymin pmax)) x2 (abs (- ymin pmin)) t1 (car jd) xy1 (abs (- (car jd) x1)) xy2 (abs (- (car jd) x2)) xy22 (- xy2 50.0) t11 (- t1 width2) t2 (+ t1 150.0))))
  139.       (setq fd1 (cons y fd1) fd1 (cons xy1 fd1))
  140.       (setq td1 (cons y td1) td1 (cons t2 td1))
  141.       (setq fd2 (cons (+ y 100.0) fd2) fd2 (cons xy2 fd2))
  142.       (setq td2 (cons (+ y 100.0) td2) td2 (cons t2 td2))
  143.       (command "solid" fd1 td1 fd2 td2 "")
  144.       (setq se (entlast))
  145.       (ssadd se ss)
  146.       (setq fd1 nil fd2 nil td1 nil td2 nil)
  147.       (setq fd1 (cons (+ y 100.0) fd1) fd1 (cons t1 fd1) td1 (cons (+ y 100.0) td1) td1 (cons t2 td1))
  148.       (setq fd2 (cons (+ y 180.0) fd2) fd2 (cons t1 fd2) td2 (cons (+ y 180.0) td2) td2 (cons t2 td2))
  149.       (command "solid" fd1 td1 fd2 td2 "")
  150.       (setq se (entlast))
  151.       (ssadd se ss)  
  152.       (setq fd1 nil fd2 nil td1 nil td2 nil)
  153.       (setq fd1 (cons (+ y 300.0) fd1) fd1 (cons xy1 fd1) fd2 (cons (+ y 300.0) fd2) fd2 (cons xy2 fd2))
  154.       (setq td1 (cons y td1) td1 (cons xy1 td1) td2 (cons y td2) td2 (cons xy2 td2))
  155.       (command "SOLID" fd1 td1 fd2 td2 "")
  156.       (setq se (entlast))
  157.       (ssadd se ss)  
  158.       (setq fd1 nil fd2 nil td1 nil td2 nil)
  159.       (setq fd1 (cons (+ y terraceh) fd1) fd1 (cons xy1 fd1))
  160.       (setq fd2 (cons (+ y terraceh) fd2) fd2 (cons xy22 fd2))
  161.       (setq td1 (cons (+ y 300.0) td1) td1 (cons xy1 td1))
  162.       (setq td2 (cons (+ y 300.0) td2) td2 (cons xy22 td2))
  163.       (command "line" fd1 td1 "")
  164.       (setq se (entlast))
  165.       (ssadd se ss)
  166.       (command "line" fd2 td2 "")
  167.       (setq se (entlast))
  168.       (ssadd se ss)
  169.       (setq td1 nil td2 nil)
  170.       (setq td1 (cons (+ y terraceh) td1) td1 (cons t11 td1))
  171.       (command "line" fd1 td1 "")
  172.       (setq se (entlast))
  173.       (ssadd se ss)
  174.       (setq a (+ a 2)))
  175. )
  176.  
  177. (defun jmw (/ x y fd1 td1 fd2 td2 d1 x jx1 jx2 jyd jyu y F1 F2 F12 F22)
  178.        (command "layer" "M" "swindow" "c" "7" "" "")
  179.        (setq x (car jd) y (cadr jd) fd1 nil td1 nil fd2 nil td2 nil ind nil)
  180.        (setq jx1 (+ (abs (- j1 ymin)) x) jx2 (+ (abs (- j2 ymin)) x) jyd (+ y wh) jyu (+ jyd h))
  181.        (if (eq fg "Col") (setq d1 (cadr in)) (setq d1 (car in)))
  182.        (setq inx (+ (abs (- d1 ymin)) x) iny (+ jyd (/ h 2)))
  183.        (setq ind (cons iny ind) ind (cons inx ind))
  184.        (setq fd1 (cons jyu fd1) fd1 (cons jx1 fd1) td1 (cons jyu td1) td1 (cons jx2 td1)) 
  185.        (setq fd2 ( cons (+ jyu (/ l 10)) fd2) fd2 (cons jx1 fd2) td2 (cons (+ jyu (/ l 10)) td2) td2 (cons jx2 td2)) 
  186.        (command "solid" fd1 td1 fd2 td2 "")
  187.        (setq se (entlast))
  188.        (ssadd se ss)
  189.        (setq fd1 nil fd2 nil td1 nil td2 nil f1 nil f2 nil f12 nil f22 nil)
  190.        (if (or (eq px "L") (eq px "U"))
  191.        (setq x1 (+ jx1 width2) x2 (- jx2 width2))
  192.        (setq x1 (- jx1 width2) x2 (+ jx2 width2)))
  193.        (if (> wh 0)
  194.        (setq y1 jyu y2 (+ jyd width2))
  195.        (setq y1 jyu y2 jyd))
  196. (setq fd1 (cons y1 fd1) fd1 (cons x1 fd1) td1 (cons y2 td1) td1 (cons x1 td1))
  197. (setq fd2 (cons y1 fd2) fd2 (cons x2 fd2) td2 (cons y2 td2) td2 (cons x2 td2))
  198.        (setq f1 (cons jyd f1) f1 (cons jx1 f1) f2 (cons jyd f2) f2 (cons jx2  f2))
  199.        (setq f12 (cons jyd f12) f12 (cons (+ jx1 width2) f12) f22 (cons jyd f22) f22 (cons (+ jx2 width2) f22))
  200.        (setq mlxy (cons f1 mlxy) mlxy (cons f2 mlxy))
  201.   (setq oldsn (entlast))
  202.   (command "break" "c" f1 f12 fd1 td1)
  203.    (while (/= (setq oldsn (entnext oldsn)) nil) (ssadd oldsn ss))
  204.    (setq oldsn (entlast))
  205.    (command "break" "c" f2 f22 fd2 td2)
  206.    (while (/= (setq oldsn (entnext oldsn)) nil) (ssadd oldsn ss))
  207.    (if (> wh 0) (progn
  208.     (setq fd1 nil td1 nil att "CC")
  209.     (setq fd1 (cons jyd fd1) fd1 (cons x1 fd1) td1 (cons jyd td1) td1 (cons x2 td1))
  210.      (command "PLINE" fd1 "W" width width td1 "")
  211.        (setq se (entlast))
  212.        (ssadd se ss))
  213.        (setq att "DOOR")
  214.    )
  215.        (setq ww (/ (+ w width) 10) ll (/ h 100))
  216.        (setq atf (strcat (itoa h) " " (itoa wh)))
  217.        (command "INSERT" att ind ll ww 90 atf)
  218.        (setq se (entlast))
  219.        (ssadd se ss)
  220. ) 
  221.  
  222. (defun mmw (/ mx pt1 pt2 pt3 pt4 my)
  223.    (command "layer" "M" "spwindow" "c" "7" "" "")
  224.    (if (= fg "Col")
  225.       (setq pt1 (cadr in))
  226.       (setq pt1 (car in))
  227.    )
  228.    (if (or (eq px "L") (eq px "U"))
  229.      (if (> pt1 ymin)
  230.      (setq mx (+ (car jd) (- pt1 ymin)))
  231.      (setq mx (abs (- (car jd) (abs (- ymin pt1)))))
  232.     )
  233.    )
  234.   (if (or (eq px "R") (eq px "D"))
  235.     (if (< pt1 ymin)
  236.        (setq mx (+ (car jd) (abs (- pt1 ymin))))
  237.        (setq mx (abs (- (car jd) (abs (- pt1 ymin)))))
  238.     )
  239.   )
  240.    (setq pt1 nil pt2 nil pt3 nil pt4 nil my (+ (cadr jd) h wh))
  241.    (setq pt1 (cons my pt1) pt1 (cons (- mx (/ l 2)) pt1) pt2 (cons my pt2) pt2 (cons (+ mx (/ l 2)) pt2))
  242.    (setq mlxy (cons pt1 mlxy) mlxy (cons pt2 mlxy))
  243.    (setq pt3 (cons (- my h) pt3) pt3 (cons (- mx (/ l 2)) pt3) pt4 (cons (- my h) pt4) pt4 (cons (+ mx (/ l 2)) pt4))
  244.    (command "pline" pt3 "W" 1.0 1.0 pt4  pt2 pt1 "C")
  245.    (setq se (entlast))
  246.    (ssadd se ss)
  247. )
  248.  
  249. (defun pinput (/ WID)
  250.     (initget (+ 2 4))
  251.     (setq censu (getint "\n╩Σ╚δ▓π╩²<2>:"))
  252.         (if (= censu nil) (setq censu 2))
  253.     (initget (+ 2 4))
  254.     (setq cengao (getint "\n╩Σ╚δ▓π╕▀<3500>:"))
  255.         (if (= cengao nil) (setq cengao 3500))
  256.     (initget (+ 2 4))
  257.     (setq bho (getint "\n╩Σ╚δ┬Ñ░σ║±╢╚<120>:"))
  258.         (if (= bho nil) (setq bho 120))
  259.         (if (>= bho cengao) (paoerr "┬Ñ░σ║±╢╚┤≤╙┌▓π╕▀!"))
  260.         (initget (+ 2 4))
  261.         (setq qh (getint "\n╩Σ╚δ╚ª┴║╕▀╢╚<240>:"))
  262.         (if (= qh nil) (setq qh 240))
  263.         (if (>= qh cengao) (paoerr "╚ª┴║╕▀╢╚┤≤╙┌▓π╕▀!"))  
  264.         (initget (+ 2 4))
  265.         (setq qw (getint "\n╩Σ╚δ╚ª┴║┐φ╢╚<240>:"))
  266.         (if (= qw nil) (setq qw 240))  
  267.         (initget (+ 2 4))
  268.       (setq wid (getreal "\n╩Σ╚δ╞╩╧▀╗µ═╝┐φ╢╚(mm)<0.5>:"))
  269.         (if (= wid nil) (setq wid 0.5))
  270.       (setq bl (getvar "USERR1") width (* wid bl) width2 (/ width 2.0))
  271.    (graphscr)
  272.    (initget 1 "File")
  273.    (setq jd (getpoint "\n╞╩├µ═╝┤µ┼╠F/<▓σ╚δ╗∙╡π>:"))
  274.    (if (= jd "File") (progn
  275.    (setq flag "File")
  276.    (setq pas t)
  277.    (while pas
  278.    (setq file (getstring "\n╞╩├µ═╝╬─╝■├√:"))
  279.    (if (findfile (strcat file ".DWG")) (progn
  280.        (initget "Yes No")
  281.        (setq kword (getkword "\n╕├╬─╝■╥╤╛¡┤µ╘┌,╓╪╨┤┬≡(Y/N)"))
  282.        (if (= kword "Yes") (setq pas nil))
  283.    ) (setq pas nil))
  284.    )
  285.    (setq jd (getpoint "\n▓σ╚δ╗∙╡π:")) ))
  286.     (initget (+ 2 4) "Col Row")
  287.     (setq fg (getkword "\n╤í╘±╞╩╟╨╧▀╨╬╩╜:/║ß╞╩Col/╫▌╞╩Row <Col>:"))
  288.         (if (= fg nil) (setq fg "Col"))
  289.         (if (eq fg "Col")   (progn
  290.           (initget (+ 2 4) "L R") 
  291.           (setq px (getkword "\n╤í╘±: ╧≥╫≤┐┤L/╧≥╙╥┐┤R <L>:"))
  292.             (if (= px nil) (setq px "L"))
  293.                              )
  294.                              (progn
  295.           (initget (+ 2 4) "U D")
  296.           (setq px (getkword "\n╤í╘±: ╧≥╔╧┐┤U/╧≥╧┬┐┤D <U>:"))
  297.              (if (= px nil) (setq px "U"))
  298.                              )
  299.         ) 
  300.         (setvar "ORTHOMODE" 1)
  301.     (initget 1)
  302.     (setq p1 (getpoint "\n╩Σ╚δ╞╩╟╨╧▀╡┌╥╗╡π:"))
  303.     (initget 1)
  304.     (setq p2 (getpoint p1 "\n╩Σ╚δ╞╩╟╨╧▀╡┌╢■╡π:"))
  305.     (setq p3 (getpoint p2 "\n╩Σ╚δ╞╩╟╨╧▀╡┌╚²╡π:"))
  306.         (if (/= p3 nil) (progn
  307.           (initget 1)
  308.       (setq p4 (getpoint p3 "\n╩Σ╚δ╞╩╟╨╧▀╓╒╡π:"))
  309.         )) 
  310.         (while (= sj nil)
  311.     (princ "\n╤í╘±╞╩╟╨╩╡╠σ:")
  312.     (setq sj (ssget))
  313.         )
  314.     (setq sL (sslength sj))
  315.         (princ "\n╒²╘┌╝∞╦≈...╟δ╔╘║≥!")
  316. )
  317.  
  318. (defun lij ( / b b2)
  319.      (if (and (= (TYPE jxy) 'LIST) (= jbg 0)) (progn
  320.       (setq b 0 jbg 1)
  321.       (if (eq fg "Col") (setq b2 (cadr b1)) (setq b2 (car b1))) 
  322.       (while (< b njxy)
  323.         (if (<= (abs (- (nth b jxy) b2)) width)
  324.          (setq b njxy a2 n bg 0)
  325.          (setq b (+ b 1))
  326.         )
  327.       )
  328.                                )
  329.      )
  330. )
  331.  
  332. (defun lilr (/ b bg a1 a2 jbg v v1 v2 v3 e e1)
  333.    (setq b 0 bg 0 a1 0 a2 2 jbg 0 e nil e1 nil)
  334.    (setq e1 (mapcar 'car lxy2))
  335.    (if (eq px "L") (setq e (apply 'min e1)) (setq e (apply 'max e1)))
  336.    (while (< a1 n)
  337.     (setq b1 (nth a1 lxy2))
  338.     (while (< a2 (- n 1))
  339.      (setq c1 (nth a2 lxy2) c2 (nth (+ a2 1) lxy2))
  340.     (if (eq px "L") (setq v (car c1) v1 (car c2) v2 (car b1) v3 v2)
  341.                     (setq v (car b1) v1 v v2 (car c1) v3 (car c2))
  342.     )
  343.  
  344. (if (and (or (/= (car c1) (car b1)) (/= (cadr c1) (cadr b1))) 
  345.          (or (/= (car c2) (car b1)) (/= (cadr c2) (cadr b1))))
  346.    (if (or (> v v2) (> v1 v3))
  347.      (if (or (and (> (cadr c1) (cadr b1)) (> (cadr c2) (cadr b1)))
  348.              (and (< (cadr c1) (cadr b1)) (< (cadr c2) (cadr b1))))
  349.      (progn
  350.      (setq bg 1)
  351.      (lij)
  352.     )
  353.       (setq bg 0 a2 n)
  354.    )
  355.      (progn (setq bg 1) (lij))
  356.   )
  357. )
  358.      (setq a2 (+ a2 2)))
  359.      (if (and (= bg 1) (> (abs (- (car b1) e)) 370.0))
  360.        (setq lxy (cons b1 lxy)))
  361.      (setq a2 0 bg 0 jbg 0)
  362.      (setq a1 (+ a1 1)))
  363. )
  364.  
  365. (defun lidu (/ b bg a1 a2 jbg v v1 v2 v3 e e1)
  366.    (setq b 0 bg 0 a1 0 a2 2 jbg 0 e nil e1 nil)
  367.    (setq e1 (mapcar 'cadr lxy2))
  368.    (if (eq px "U") (setq e (apply 'max e1)) (setq e (apply 'min e1)))
  369.    (while (< a1 n)
  370.     (setq b1 (nth a1 lxy2))
  371.     (while (< a2 (- n 1))
  372.      (setq c1 (nth a2 lxy2) c2 (nth (+ a2 1) lxy2))
  373.      (if (eq px "D") (setq v (cadr c1) v1 (cadr c2) v2 (cadr b1) v3 v2)
  374.                      (setq v (cadr b1) v1 v v2 (cadr c1) v3 (cadr c2))
  375.      )
  376. (if (and (or (/= (car c1) (car b1)) (/= (cadr c1) (cadr b1))) 
  377.          (or (/= (car c2) (car b1)) (/= (cadr c2) (cadr b1))))
  378.    (if (or (> v v2) (> v1 v3))
  379.        (if (or (and (> (car c1) (car b1)) (> (car c2) (car b1)))
  380.                (and (< (car c1) (car b1)) (< (car c2) (car b1))))
  381.     (progn
  382.      (setq bg 1)
  383.      (lij)
  384.      )
  385.      (setq bg 0 a2 n)
  386.    )
  387.     (progn (setq bg 1) (lij))
  388.  )
  389. )
  390.      (setq a2 (+ a2 2)))
  391.    (if (and (= bg 1) (> (abs (- (cadr b1) e)) 370.0))
  392.        (setq lxy (cons b1 lxy)))
  393.      (setq a2 0 bg 0 jbg 0)
  394.      (setq a1 (+ a1 1)))
  395. )
  396. (defun range (tab / w c d mn mx)
  397.   (setq c (mapcar 'car tab) mn (apply 'min c) mn (1- mn))
  398.   (while (< mn (setq mx (apply 'max c)))
  399.    (setq c (subst mn mx c))
  400.    (while (setq d (assoc mx tab))
  401.      (setq tab (subst '(nil) d tab) w (cons d w))
  402.    )
  403.  )
  404. )
  405.  
  406.  
  407. (defun sli (/ a lay li t1 pl pg)
  408.     (setq a 0 lxy2 nil)
  409.         (if (= p3 nil) (setq pl p1 pg p1) (progn
  410.                (if (and (eq px "L") (<= (car p1) (car p3)))
  411.                  (setq pl p1 pg p3)
  412.                )
  413.                (if (and (eq px "R") (>= (car p1) (car p3)))
  414.                  (setq pl p3 pg p1)
  415.                )
  416.                (if (and (eq px "U") (<= (cadr p1) (cadr p3)))
  417.                  (setq pl p1 pg p3)
  418.                )
  419.                (if (and (eq px "D") (>= (cadr p1) (cadr p3)))
  420.                  (setq pl p3 pg p1)
  421.                )
  422.         )) 
  423.     (while (<= a (1- sL))
  424.              (SETQ PT1 NIL PT2 Nil jo nil t1 0)
  425.              (setq sn (ssname sj a))
  426.         (setq s1 (entget sn))
  427.         (setq li (cdr (assoc 0 s1)) lay (cdr (assoc 8 s1)))
  428.         (if (and (eq li "LINE") (eq (substr lay 1 5) "PWALL")) (progn
  429.                 (setq pt (cdr (assoc 10 s1)))
  430.                 (if (= (type pt) 'LIST)  (progn
  431.                      (setq pt1 (cons (cadr pt) pt1) pt1 (cons (car pt) pt1))
  432.                   (setq pt (cdr (assoc 11 s1)))
  433.                     (setq pt2 (cons (cadr pt) pt2) pt2 (cons (car pt) pt2))
  434.                        (if (and (eq px "L") (< (car pt1) (car pl)) 
  435.                                    (< (car pt2) (car pl)))
  436.                              (setq t1 1)
  437.                        )
  438.                        (if (and (eq px "R")
  439.                                 (> (car pt1) (car pg)) 
  440.                                 (> (car pt2) (car pg)))
  441.                            (setq t1 1)
  442.                        )
  443.                        (if (and (eq px "U") 
  444.                                 (> (cadr pt1) (cadr pg))
  445.                                 (> (cadr pt2) (cadr pg)))
  446.                            (setq t1 1)
  447.                        )
  448.                        (if (and (eq px "D") 
  449.                                 (< (cadr pt1) (cadr pl))
  450.                                 (< (cadr pt2) (cadr pl)))
  451.                            (setq t1 1)
  452.                        )
  453.          (if (/= t1 1) (progn
  454.                     (setq jo (inters p1 p2 pt1 pt2))
  455.                     (if (and (/= p3 nil) (/= (type jo) 'LIST))
  456.                        (setq jo (inters p3 p4 pt1 pt2))
  457.                     )
  458.                  ))    
  459.                  (if (and (/= (type jo) 'LIST) (= t1 1))
  460.                    (if (or (and (eq fg "Col") (/= (cadr pt1) (cadr pt2)))
  461.                            (and (eq fg "Row") (/= (car pt1) (car pt2))))
  462.                        (setq lxy2 (cons pt2 lxy2) lxy2 (cons pt1 lxy2))))
  463.                                                   )
  464.                         )
  465.                 (IF (= (TYPE JO) 'LIST) (PROGN
  466.                   (if (eq fg "Col")  
  467.                            (setq jxy (cons (cadr jo) jxy))
  468.                              (SETQ jxy (cons (CAR JO) jxy))
  469.                           )
  470.                                         )
  471.                         )
  472.                                    )
  473.                 )
  474.              (setq a (1+ a))) 
  475.        (if (/= (TYPE LXY2) 'LIST) (paoerr "╞╩╟╨╩╡╠σ╓╨├╗╙╨╟╜!")) 
  476.        (setq n (length lxy2) njxy (length jxy))
  477.  (if (eq fg "Col") (lilr) (lidu))
  478.   (if (= (type lxy) 'LIST)
  479.     (setq lxy (range lxy))
  480.   ) 
  481. )
  482.  
  483. (defun instr(st s0 s00 / l n loop x n0 l0)
  484.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  485.    (while (and (<= n l) loop)
  486.       (setq x (substr s0 n0 1))
  487.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  488.    )
  489.    (eval l0)
  490. )
  491.  
  492. (defun asctof(rn1 / loop ll x)   
  493.        (setq loop t)
  494.        (while loop
  495.           (setq ll (instr 1 rn1 " "))
  496.           (if (= ll 0) (setq wl (cons rn1 wl) loop nil)
  497.              (progn ;else
  498.              (setq x (substr rn1 1 (1- ll)))
  499.              (setq wl (cons x wl))
  500.              (setq rn1 (substr rn1 (1+ ll) (- (strlen rn1) ll)))
  501.              (setq loop t)
  502.              )
  503.           )
  504.        )
  505. )
  506.  
  507. (defun smw ( / a s1 s2 s3 rn ne px1 py1 pt1 pt2 blkn x ll li lay ti lw wl)
  508.     (setq a 0)
  509.     (while (<= a (1- sL))
  510.              (SETQ PT1 NIL PT2 NIL ti 0)
  511.              (setq sn (ssname sj a))
  512.         (setq s1 (entget sn))
  513.         (setq li (cdr (assoc 0 s1)) lay (cdr (assoc 8 s1)))
  514.                 (if (and (eq li "INSERT") (eq lay "PWINDOW")) (progn
  515.                   (setq blkn (cdr (Assoc 2 s1)))
  516.                   (setq in (cdr (assoc 10 s1)))
  517.                  (if (or (= (substr blkn 1 3) "CCA") (= (substr blkn 1 3) "CCZ"))
  518.                    (progn
  519.                     (setq ne (entnext sn) s2 (entget ne))
  520.                     (setq rn (cdr (assoc 1 s2)) wl nil)
  521.                     (asctof rn)
  522. (setq l (atoi (nth 3 wl)) h (atoi (nth 2 wl)) wh (atoi (nth 1 wl)) w (atoi (nth 0 wl)))
  523.                     (setq ne (entnext ne) s3 (entget ne))
  524.                     (setq rn (cdr (assoc 1 s3)) wl nil)
  525.                     (asctof rn)
  526.                     (setq ag (atof (nth 0 wl)))
  527.                    )
  528.                    (progn
  529.                     (setq ag (cdr (assoc 50 s1)))
  530.                      (setq ne (entnext sn))
  531.                      (setq s2 (entget ne))
  532.                     (setq rn (cdr (assoc 1 s2)) wl nil)
  533.                     (asctof rn)
  534. (setq l (atoi (nth 3 wl)) h (atoi (nth 2 wl)) w (atoi (nth 0 wl)) wh (atoi (nth 1 wl)))
  535.                    )
  536.                   )
  537.        (if (eq fg "Col")
  538.         (if (or (equal ag (/ pi 2) 0.001) (equal ag (* pi 1.5) 0.001) (equal ag (* pi 2.5) 0.001)) (setq lw w) (setq lw l))
  539.         (if (or (equal ag 0.0 0.001) (equal ag pi 0.001) (equal ag (* 2 pi) 0.001)) (setq lw w) (setq lw l))
  540.        )       
  541.        (if (and (eq px "L") (= p3 nil) (>= (car p1) (- (car in) (/ lw 2))))
  542.            (setq ti 1)
  543.        )
  544.        (if (and (eq px "L") (/= p3 nil))
  545.          (if (< (cadr p1) (cadr p4))
  546.            (if (< (cadr in) (cadr p2))
  547.              (if (>= (car p2) (- (car in) (/ lw 2))) (setq ti 1))
  548.              (if (>= (car p3) (- (car in) (/ lw 2))) (setq ti 1))
  549.            )
  550.            (if (< (cadr in) (cadr p2))
  551.              (if (>= (car p3) (- (car in) (/ lw 2))) (setq ti 1))
  552.              (if (>= (car p2) (- (car in) (/ lw 2))) (setq ti 1))
  553.            )
  554.          )
  555.        )
  556.        (if (and (eq px "R") (= p3 nil) (<= (car p1) (+ (car in) (/ lw 2))))
  557.            (setq ti 1)
  558.        ) 
  559.        (if (and (eq px "R") (/= p3 nil))
  560.          (if (< (cadr p1) (cadr p4))
  561.            (if (< (cadr in) (cadr p2))
  562.              (if (<= (car p2) (+ (car in) (/ lw 2))) (setq ti 1))
  563.              (if (<= (car p3) (+ (car in) (/ lw 2))) (setq ti 1))
  564.            )
  565.            (if (< (cadr in) (cadr p2))
  566.              (if (<= (car p3) (+ (car in) (/ lw 2))) (setq ti 1))
  567.              (if (<= (car p2) (+ (car in) (/ lw 2))) (setq ti 1))
  568.            )
  569.          )
  570.        ) 
  571.        (if (and (eq px "U") (= p3 nil) (<= (cadr p1) (+ (cadr in) (/ lw 2))))
  572.            (setq ti 1)
  573.        )
  574.        (if (and (eq px "U") (/= p3 nil))
  575.          (if (< (car p1) (car p4))
  576.            (if (< (car in) (car p2)) 
  577.              (if (<= (cadr p2) (+ (cadr in) (/ lw 2))) (setq ti 1)) 
  578.              (if (<= (cadr p3) (+ (cadr in) (/ lw 2))) (setq ti 1))
  579.            )
  580.            (if (< (car in) (car p2)) 
  581.              (if (<= (cadr p3) (+ (cadr in) (/ lw 2))) (setq ti 1)) 
  582.              (if (<= (cadr p2) (+ (cadr in) (/ lw 2))) (setq ti 1))
  583.            )
  584.          )
  585.        )
  586.        (if (and (eq px "D") (= p3 nil) (>= (cadr p1) (- (cadr in) (/ lw 2))))
  587.            (setq ti 1)
  588.        )
  589.        (if (and (eq px "D") (/= p3 nil))
  590.          (if (< (car p1) (car p4))
  591.            (if (< (car in) (car p2))
  592.              (if (>= (cadr p2) (- (cadr in) (/ lw 2))) (setq ti 1))
  593.              (if (>= (cadr p3) (- (cadr in) (/ lw 2))) (setq ti 1))
  594.            )
  595.            (if (< (car in) (car p2))
  596.              (if (>= (cadr p3) (- (cadr in) (/ lw 2))) (setq ti 1))
  597.              (if (>= (cadr p2) (- (cadr in) (/ lw 2))) (setq ti 1))
  598.            )
  599.          ) 
  600.        )
  601.     (if (= ti 1) (progn
  602.       (setq wm (cons wh wm) wm (cons w wm) wm (cons h wm) wm (cons l wm) wm (cons in wm) wm (cons ag wm))
  603.       (if (and (eq fg "Col") (not (equal AG (/ PI 2) 0.001)) (not (equal AG (* PI 1.5) 0.001)) (not (equal ag (* 2.5 pi) 0.001)))
  604.                        (progn     
  605.                      (setq pt1 nil pt2 nil)
  606.                      (setq px1 (- (car in) (/ L 2)) py1 (- (cadr in) (/ W 2)))
  607.                         (setq pt1 (cons py1 pt1) pt1 (cons px1 pt1))
  608.                         (setq px1 (+ (car in) (/ L 2))) 
  609.                         (setq pt2 (cons py1 pt2) pt2 (cons px1 pt2))
  610.                         (setq ji (inters p1 p2 pt1 pt2))
  611.                        (if (and (/= p3 nil) (/= (type ji) 'LIST))
  612.                          (setq ji (inters p3 p4 pt1 pt2))
  613.                        )   
  614.                       (if (= (type ji) 'LIST) (progn
  615.                        (setq mxy (cons (cadr ji) mxy) wm (cons (cadr ji) wm))
  616.                       ))
  617.                      (setq px1 (- (car in) (/ L 2)) py1 (+ (cadr in) (/ W 2))) 
  618.                         (SETQ PT1 NIL PT2 NIL)
  619.                         (setq pt1 (cons py1 pt1) pt1 (cons px1 pt1))
  620.                         (setq px1 (+ (car in) (/ L 2)))
  621.                         (setq pt2 (cons py1 pt2) pt2 (cons px1 pt2))
  622.                         (setq ji (inters p1 p2 pt1 pt2))
  623.                        (if (and (/= p3 nil) (/= (type ji) 'LIST))
  624.                          (setq ji (inters p3 p4 pt1 pt2))
  625.                        )   
  626.                         (if (= (type ji) 'LIST) (progn
  627.   (setq mxy (cons (cadr ji) mxy) wm (cons (cadr ji) wm) wm (cons "J" wm))
  628.                         ))
  629.                                                   )
  630.       )
  631.       (IF (AND (EQ FG "Row") (not (equal AG 0.0 0.001)) (not (equal AG PI 0.001)) (not (equal ag (* 2 pi) 0.001)))
  632.                          (progn
  633.                         (SETQ PT1 NIL PT2 NIL)
  634.                      (setq py1 (- (cadr in) (/ L 2)) PX1 (- (CAR IN) (/ W 2)))
  635.                         (setq pt1 (cons py1 pt1) pt1 (cons px1 pt1))
  636.                         (SETQ py1 (+ (cadr in) (/ L 2)))
  637.                         (setq pt2 (cons py1 pt2) pt2 (cons px1 pt2))
  638.                         (setq ji (inters p1 p2 pt1 pt2))
  639.                        (if (and (/= p3 nil) (/= (type ji) 'LIST))
  640.                          (setq ji (inters p3 p4 pt1 pt2))
  641.                        )   
  642.                         (IF (= (TYPE JI) 'LIST) (progn
  643.                      (setq mxy (cons (car ji) mxy) wm (cons (car ji) wm))
  644.                         ))
  645.                      (setq py1 (- (cadr in) (/ L 2)) px1 (+ (car in) (/ W 2)))
  646.                         (SETQ PT1 NIL PT2 NIL)
  647.                         (setq pt1 (cons py1 pt1) pt1 (cons px1 pt1))
  648.                         (setq py1 (+ (CADR IN) (/ L 2)))
  649.                         (SETQ PT2 (CONS PY1 PT2) PT2 (CONS PX1 PT2))
  650.                         (setq ji (inters p1 p2 pt1 pt2))
  651.                        (if (and (/= p3 nil) (/= (type ji) 'LIST))
  652.                          (setq ji (inters p3 p4 pt1 pt2))
  653.                        )   
  654.                         (IF (= (TYPE JI) 'LIST) (progn  
  655.         (setq mxy (cons (car ji) mxy) wm (cons (car ji) wm) wm (cons "J" wm))
  656.                         ))
  657.                                     )
  658.        )
  659.                                            )
  660.                      )
  661.                                            )
  662.                    )
  663.              (setq a (1+ a)))
  664. )
  665.  
  666. (defun spl (/ li lay a)
  667.     (setq a 0 pxy0 nil)
  668.     (while (<= a (1- sL))
  669.              (SETQ PT1 NIL PT2 NIL)
  670.              (setq sn (ssname sj a))
  671.         (setq s1 (entget sn))
  672.         (setq li (cdr (assoc 0 s1)) lay (cdr (assoc 8 s1)))
  673.        (if (and (eq li "POLYLINE") (eq lay "TERRACE")) (progn
  674.         (setq ne (entnext sn) terraceh (cdr (assoc 39 s1)))
  675.         (setq s2 (entget ne)) 
  676.         (while (/= (cdr (assoc 0 s2)) "SEQEND")
  677.          (setq pd (cdr (assoc 10 s2)) pxy0 (cons pd pxy0))
  678.          (setq ne (entnext ne) s2 (entget ne))
  679.         )
  680.          (setq n (length pxy0) pa 0)
  681.          (while (< pa (1- n))
  682.           (setq pt1 (nth pa pxy0) pt2 (nth (1+ pa) pxy0))
  683.          (setq jo (inters (list (car p1) (cadr p1)) (list (car p2) (cadr p2))
  684.                     (list (car pt1) (cadr pt1)) (list (car pt2) (cadr pt2))))
  685.          (if (and (/= p3 nil) (/= (type jo) 'LIST))
  686.            (setq jo (inters (p3 p4 (list (car pt1) (cadr pt1)) (list (car pt2)
  687.                             (cadr pt2)))))
  688.          )
  689.           (if (= (type jo) 'LIST) (progn
  690.            (if (eq fg "Col") (setq pj (cons (cadr jo) pj)) (setq pj (cons (car jo) pj)))
  691.                                   )
  692.                                   (progn
  693.            (setq  pxy (cons pt2 pxy))))
  694.           (setq pa (+ pa 1)))
  695.          (setq pxy0 nil)))
  696.    (setq a (1+ a)))
  697. )
  698.  
  699. (defun aj (/ y1 y1n y2 y2n)
  700.     (if (or (eq px "U")  (eq px "L")) (progn 
  701.       (if (= (type jxy) 'LIST)  (setq y1 (apply 'min jxy) y1n (apply 'max jxy))
  702.          (setq y1 999999.0 y1n 0.0))
  703.      (if (= (type mxy) 'LIST) (setq y2 (apply 'min mxy) y2n (apply 'max mxy))
  704.          (setq y2 999999.0 y2n 0.0))
  705.      (if (<= y1 y2) (setq ymin y1) (setq ymin y2))
  706.      (if (<= y1n y2n) (setq ymax y2n) (setq ymax y1n))
  707.    )) 
  708.   (if (or (eq px "D") (eq px "R")) (progn
  709.       (if (= (type jxy) 'LIST) (setq y1 (apply 'max jxy) y1n (apply 'min jxy))
  710.              (setq y1 0.0 y1n 999999.0))
  711.       (if (= (type mxy) 'LIST) (setq y2 (apply 'max mxy) y2n (apply 'min mxy))
  712.              (setq y2 0.0 y2n 999999.0))
  713.       (if (<= y1 y2) (setq ymin y2) (setq ymin y1))
  714.       (if (<= y1n y2n) (setq ymax y1n) (setq ymax y2n))
  715.   ))
  716.     (if (= (type mxy) 'LIST) (setq xy (append mxy xy)))
  717.     (if (= (type jxy) 'LIST) (setq xy (append jxy xy)))
  718. )
  719.  
  720. (defun ph (/ fd td x1 x2 y1 y2 ag1 ag2)
  721.        (setq fd nil td nil)
  722.        (command "LAYER" "M" "PBH" "C" "7" "" "")
  723.        (if (eq fg "Col")
  724.          (if (/= p4 nil) (setq x1 (car p1) x2 (car p4))
  725.                          (setq x1 (car p1) x2 x1)
  726.        ))
  727.        (if (eq fg "Row")
  728.          (if (/= p4 nil) (setq y1 (cadr p1) y2 (cadr p4))
  729.                          (setq y1 (cadr p1) y2 y1)
  730.        ))  
  731.        (if (eq px "L")
  732.          (setq y1 (- ymin (* 10 bl)) y2 (+ ymax (* 10 bl)) ag1 180 ag2 0))
  733.        (if (eq px "R")  
  734.          (setq y1 (+ ymin (* 10 bl)) y2 (- ymax (* 10 bl)) ag1 0 ag2 180))
  735.        (if (eq px "U") 
  736.          (setq x1 (- ymin (* 10 bl)) x2 (+ ymax (* 10 bl)) ag1 90 ag2 270))
  737.        (if (eq px "D") 
  738.          (setq x2 (- ymax (* 10 bl)) x1 (+ ymin (* 10 bl)) ag1 270 ag2 90))
  739.          (setq fd (cons y1 fd) fd (cons x1 fd) td (cons y2 td) td (cons x2 td))
  740.          (command "INSERT" "PB2" fd 1 1 ag2)
  741.          (command "INSERT" "PB1" td 1 1 ag1)
  742.        (if (and (eq fg "Col") (/= p3 nil)) (progn
  743.          (if (< (cadr p1) (cadr p4)) (progn
  744.            (if (< (car p2) (car p3)) (progn
  745.             (command "INSERT" "PB3" p2 1 1 270)
  746.             (command "INSERT" "pb3" p3 1 1 90))
  747.                                     (progn
  748.             (command "INSERT" "PB3" p2 1 1 180)
  749.             (command "INSERT" "PB3" p3 1 1 0))
  750.           )) (progn
  751.           (if (< (car p2) (car p3)) (progn
  752.             (command "INSERT" "PB3" p2 1 1 0)
  753.             (command "INSERT" "pb3" p3 1 1 180))
  754.                                     (progn
  755.             (command "INSERT" "PB3" p2 1 1 90)
  756.             (command "INSERT" "PB3" p3 1 1 270))
  757.          )))
  758.       ))
  759.        (if (and (eq fg "Row") (/= p3 nil)) (progn 
  760.          (if (< (car p1) (car p4)) (progn
  761.            (if (< (cadr p2) (cadr p3)) (progn
  762.             (command "INSERT" "PB3" p2 1 1 90)
  763.             (command "INSERT" "pb3" p3 1 1 270))
  764.                                     (progn
  765.             (command "INSERT" "PB3" p2 1 1 180)
  766.             (command "INSERT" "PB3" p3 1 1 0))
  767.          )) (progn
  768.           (if (< (cadr p2) (cadr p3)) (progn
  769.             (command "INSERT" "PB3" p2 1 1 0)
  770.             (command "INSERT" "pb3" p3 1 1 180))
  771.                                     (progn
  772.             (command "INSERT" "PB3" p2 1 1 270)
  773.             (command "INSERT" "PB3" p3 1 1 90))
  774.         )))
  775.       ))
  776. )
  777.  
  778.  
  779. (defun mw1 ( / f s a b a2 a3 n n2 nlxy jbg bg ay1 ay2 ax1 ax2 axmax aymin aymax axmin)
  780.         (if (= (type wm) 'LIST) (progn
  781.         (setq nlxy (length lxy2))
  782.         (setq n (length wm) a 0 temp wm)
  783.         (while (< a n)
  784.           (setq b (nth a wm) a2 0 a3 0 jbg 0 bg 0)
  785.           (if (= b "J") (progn
  786.            (setq j1 (nth (+ a 1) wm) j2 (nth (+ a 2) wm) ag (nth (+ a 3) wm) in (nth (+ a 4) wm))
  787.            (setq l (nth (+ a 5) wm) h (nth (+ a 6) wm) w (nth (+ a 7) wm) wh (nth (+ a 8) wm) a (+ a 8))
  788.            (setq jbg 1)
  789.            (jmw)))
  790.         (if (and (eq fg "Col") (/= b "J") (not (equal b 0.0 0.001)) (not (equal b pi 0.001)) (not (equal  b (* pi 2) 0.001))) 
  791.                (progn 
  792.            (setq in (nth (+ a 1) wm) l (nth (+ a 2) wm) h (nth (+ a 3) wm) w (nth (+ a 4) wm) wh (nth (+ a 5) wm) a (+ a 5))
  793.            (setq iny (cadr in) inx (car in))
  794.           (while (< a2 nlxy)
  795.           (setq f (nth a2 lxy2) ay1 (cadr f) ax1 (car f) s (nth (1+ a2) lxy2) ay2 (cadr s) ax2 (car s))
  796.           (setq aymax (max ay1 ay2) aymin (min ay1 ay2) axmax (max ax1 ax2) axmin (min ax1 ax2))
  797.           (if (eq px "L")  (progn
  798.            (if (and (> axmin inx) (> aymax (+ iny (/ l 2))) (< aymin (- iny (/ l 2))))
  799.             (setq a2 nlxy bg 0)
  800.             (setq bg 1 a2 (+ a2 2)))
  801.                             )
  802.                             (progn
  803.              (if (and (< axmin inx) (> aymax (+ iny (/ l 2))) (< aymin (- iny (/ l 2))))
  804.               (setq a2 nlxy bg 0)
  805.               (setq bg 1 a2 (+ a2 2)))
  806.                           )
  807.       ))))
  808.        (if (and (eq fg "Row") (/= b "J") (not (equal b (* pi 0.5) 0.001)) (not (equal  b (* pi 1.5) 0.001)) (not (equal b (* 2.5 pi) 0.001)))
  809.                  (progn 
  810.           (setq in (nth (+ a 1) wm) l (nth (+ a 2) wm) h (nth (+ a 3) wm) w (nth (+ a 4) wm) wh (nth (+ a 5) wm) a (+ a 5))
  811.           (setq inx (car in) iny (cadr in))
  812.           (while (< a2 nlxy)
  813.           (setq f (nth a2 lxy2) ax1 (car f) ay1 (cadr f) s (nth (1+ a2) lxy2) ax2 (car s) ay2 (cadr s))
  814.           (setq axmax (max ax1 ax2) axmin (min ax1 ax2) aymax (max ay1 ay2) aymin (min ay1 ay2))
  815.           (if (eq px "U") (progn
  816.             (if (and (< aymax iny) (> axmax (+ inx (/ l 2))) (< axmin (- inx (/ l 2))))
  817.                (setq a2 nlxy bg 0)
  818.             (setq bg 1 a2 (+ a2 2)))
  819.                           )
  820.                           (progn
  821.           (if (and (> aymin iny) (> axmax (+ inx (/ l 2))) (< axmin (- inx (/ l 2))))
  822.              (setq a2 nlxy bg 0)
  823.            (setq bg 1 a2 (+ a2 2)))
  824.                           )
  825.       ))))
  826.           (if (and (= bg 1) (/= b "J")) (progn
  827.            (setq n2 (length temp))
  828.            (while (< A3 N2)
  829.             (setq b2 (nth a3 temp))
  830.             (if (= b2 "J") (setq a3 (+ a3 3)))
  831.             (if (and (eq fg "Col") (/= b2 "J") (not (equal b2 0.0 0.001)) (not (equal b2 pi 0.001)) (not (equal b2 (* 2 pi) 0.001)))
  832.                    (progn
  833.             (setq in2 (nth (1+ a3) temp) l2 (nth (+ a3 2) temp))
  834.              (setq iny2 (cadr in2) inx2 (car in2))
  835.              (setq ii (abs (- iny2 (cadr in))) ll (+ (/ l 2) (/ l2 2)))
  836.              (if (and (eq px "L") (> inx2 (car in)) (< ii ll)) 
  837.               (setq bg 0))
  838.              (if (and (eq px "R") (< inx2 (car in)) (< ii ll))
  839.               (setq bg 0))))
  840.             (if (and (eq fg "Row") (/= b2 "J") (not (equal b2 (/ pi 2) 0.001)) (not (equal b2 (* pi 1.5) 0.001)) (not (equal b2 (* pi 2.5) 0.001)))
  841.                    (progn
  842.             (setq in2 (nth (1+ a3) temp) l2 (nth (+ a3 2) temp))
  843.              (setq iny2 (cadr in2) inx2 (car in2))
  844.              (setq ii (abs (- inx2 (car in))) ll (+ (/ l 2) (/ l2 2)))
  845.              (if (and (eq px "U") (< iny2 (cadr in)) (< ii ll))
  846.               (setq bg 0))
  847.              (if (and (eq px "D") (> iny2 (cadr in)) (< ii ll))
  848.               (setq bg 0))))
  849.             (setq a3 (+ a3 6))
  850.           )))
  851.           (if (= bg 1) (progn
  852.            (if (equal (abs (cos b)) 0.0 0.001) (setq l l) (setq l (* l (abs (cos b)))))
  853.                   (mmw))
  854.           )  
  855.          (if (or (= jbg 1) (= bg 1) (= a2 nlxy)) (setq a (1+ a)))
  856.           (if (and (= jbg 0) (= bg 0) (/= a2 nlxy)) (setq a (+ a 6)))
  857.        ))) 
  858. )
  859.  
  860.  
  861. (defun paoerr(s)
  862.    (if (/= s "Function cancelled")
  863.        (princ (strcat "\nError:" s))
  864.    )
  865.    (command "layer" "s" "0" "")
  866.    (setvar "cmdecho" 1)
  867.    (setq *error* oer)
  868.    (princ)
  869. )
  870.  
  871. (defun C:PAO (/ oer a n n1 n2 sj sn ne pt1 pt2 px1 px2 py1 pd pa x1 xl ws x2 a2 a3
  872.  ax1 iny ay1 temp ag bg ii ll nlxy jbg pxy0 sl p1 p2 p3 p4 jd px fg qw qh bho cengao
  873.  censu width width2 ymin ymax jxy lxy wm mxy xy pxy pj lxy2 s1 li lay jo y1 y1n
  874.  y2 y2n b v v1 b1 njxy pxy0 s2 se ss rn yn xl2 wl t1 t2 x y fd1 td1 fd2
  875.  td2 jx1 j1 jx2 j2 jyd jyu wh h xmax xmin c f1 f2 cm l l2 w in j ji in in2 inx iny2
  876.  axmin axmax aymin aymax ax1 ay1 ax2 ay2 mn mx d file kword flag mlxy)
  877.  (setvar "cmdecho" 0);(setq oer *error* *error* paoerr)
  878.  (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  879.  (setq sj nil sl nil p1 nil p2 nil p3 nil p4 nil jd nil px nil fg nil qh nil qw nil bho nil cengao nil censu nil)
  880.  (setq width nil width2 nil ymax nil ymin nil jxy nil lxy nil mlxy nil wm nil mxy nil xy nil pxy nil pj nil)
  881.         (pinput)
  882.         (sli)
  883.         (smw)
  884.         (spl)
  885.         (aj)
  886.         (ph)
  887.     (command "layer" "M" "SWALL" "C" "7" "" "")
  888.         (setq ss (ssadd))
  889.         (setq se nil)
  890.          (drl)
  891.          (ban)
  892.          (load "lisp\\sst") (sst)
  893.          (mw1)
  894.          (if (= (type lxy) 'LIST) (kx))
  895.          (if (= (type pj) 'LIST) (st))
  896.      (setq jxy nil lxy nil lxy2 nil wm nil mxy nil xy nil pxy nil pj nil )
  897.      (setq entl (entlast))
  898.      (if (> censu 1) (command "array" ss "" "R" censu 1 cengao))
  899.      (command)
  900.      (if (eq flag "File") (progn
  901.      (while (/= (setq entl (entnext entl)) nil) (ssadd entl ss))
  902.      (if (eq kword "Yes") (command "wblock" file "Y" "" jd ss "") (command "wblock" file "" jd ss ""))))
  903.      (command "layer" "s" "0" "")
  904.      (setvar "cmdecho" 1) (setq *error* oer) (princ)
  905. )
  906.