home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / TWALL.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  4.0 KB  |  100 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 "dimse1" 0)
  14.    (setvar "dimse2" 0)
  15.    (setvar "dimrnd" 0)
  16.    (setq *error* oer)
  17.    (princ)
  18. )
  19.  
  20. (defun C:TWALL(/ na oer sp ep ss ssl n n1 l loop pl pl1 sn sn1 en en1 ename elay sp1 ep1 intp1 r dmax d1 np np1)
  21.    (setvar "cmdecho" 0)
  22.    (setvar "orthomode" 1)
  23.    (setq oer *error* *error* twerr)
  24.    (setq sp (getpoint "\n▒Ω╫ó╞≡╡π:"))
  25.    (setq ep (getpoint sp "\n▒Ω╫ó╓╒╡π:"))
  26.    (setq ss (ssget "C" sp ep))
  27.    (if ss (progn
  28.    (setq ssl (sslength ss) n 0 loop t pl nil)
  29.    (while (and (< n ssl) loop)
  30.       (setq sn (ssname ss n) en (entget sn))
  31.       (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  32.       (if (and (= "LINE" ename) (member (substr elay 1 5) '("PWALL" "PAXIS" "PDIM"))) (progn
  33.           (setq sp1 (cdr (assoc 10 en)) ep1 (cdr (assoc 11 en)))
  34.           (setq intp1 (inters sp1 ep1 sp ep))
  35.           (if intp1 (setq pl (cons intp1 pl)))
  36.           ) ;end progn
  37.        (progn ;else
  38.        (if (and (= "ARC" ename) (member (substr elay 1 5) '("PWALL" "PAXIS"))) (progn
  39.            (setq sp1 (cdr (assoc 10 en)) r (cdr (assoc 40 en)))
  40.            (setq intp1 (polar sp1 (angle sp1 sp) r))
  41.            (if intp1 (setq pl (cons intp1 pl)))
  42.        ))
  43.        )) ;end if
  44.        (setq n (1+ n))
  45.           (if (= (setq l (length pl)) 3) (setq loop nil))
  46.    )
  47.    (if (or (= l 3) (= l 2))
  48.    (if (= l 3) (progn
  49.        (setq d1 (list (distance sp (nth 0 pl)) (distance sp (nth 1 pl)) (distance sp (nth 2 pl))) pl1 nil)
  50.        (setq n 0)
  51.        (repeat l
  52.           (setq dmax (apply 'max d1) n1 0)
  53.           (repeat l
  54.              (if (= dmax (nth n1 d1)) (setq pl1 (cons (nth n1 pl) pl1) d1 (subst 0.0 dmax d1)))
  55.              (setq n1 (1+ n1))
  56.           )
  57.           (setq n (1+ n))
  58.         )
  59.         (command "layer" "m" "pdim" "c" "3" "pdim" "")
  60.         (command "color" "bylayer")
  61.         (command "dim" "dimse1" "on" "dimse2" "on" "dimrnd" 10 "style" "standard")
  62.         (command "rotate" (/ (* (angle sp ep) 180.0) pi) (nth 0 pl1) (nth 1 pl1) (nth 0 pl1) "")
  63.         (setq sn (entlast) en (entget sn))
  64.         (command "rotate" (/ (* (angle sp ep) 180.0) pi) (nth 1 pl1) (nth 2 pl1) (nth 1 pl1) "")
  65.         (setq sn1 (entlast) en1 (entget sn1))
  66.         (setq np (polar (cdr (assoc 11 en)) (+ pi (angle sp ep)) 400))
  67.         (setq np1 (polar (cdr (assoc 11 en1)) (angle sp ep) 400))
  68.         (setq en (subst (cons 70 128) (assoc 70 en) en))
  69.         (entmod (subst (cons 11 np) (assoc 11 en) en))
  70.         (setq en1 (subst (cons 70 128) (assoc 70 en1) en1))
  71.         (entmod (subst (cons 11 np1) (assoc 11 en1) en1))
  72.         (command "dimse1" "off" "dimse2" "off" "dimrnd" 0 "style" "hz" "exit")
  73.         (command "layer" "s" "0" "")
  74.    ) ;progn l=3
  75.    (progn ;else l=2
  76.    (setq d1 (distance sp (nth 0 pl)) d2 (distance sp (nth 1 pl)))
  77.    (setq pl1 nil)
  78.    (if (> d1 d2) (setq pl1 (cons (nth 0 pl) pl1) pl1 (cons (nth 1 pl) pl1)) (setq pl1 (cons (nth 1 pl) pl1) pl1 (cons (nth 0 pl) pl1)))
  79.         (command "layer" "m" "pdim" "c" "3" "pdim" "")
  80.         (command "color" "bylayer")
  81.         (command "dim" "dimse1" "on" "dimse2" "on" "dimrnd" 10 "style" "standard")
  82.         (command "rotate" (/ (* (angle sp ep) 180.0) pi) (nth 0 pl1) (nth 1 pl1) (nth 0 pl1) "")
  83.         (setq sn (entlast) en (entget sn))
  84.         (setq na (getangle (setq np (cdr (assoc 11 en))) "\n╩²╫╓╥╞╢»╖╜╧≥:"))
  85.         (if (/= na nil) (progn
  86.             (setq en (subst (cons 70 128) (assoc 70 en) en))
  87.             (setq np1 (polar np na 500))
  88.             (entmod (subst (cons 11 np1) (assoc 11 en) en))
  89.         ))
  90.         (command "dimse1" "off" "dimse2" "off" "dimrnd" 0 "style" "hz" "exit")
  91.         (command "layer" "s" "0" "")
  92.    )) ;end if 
  93.    )
  94. ))
  95.    (setvar "orthomode" 0)
  96.    (setvar "cmdecho" 1)
  97.    (setq *error* oer)
  98.    (princ)
  99. )
  100.