home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / INSWIN.LSP < prev    next >
Encoding:
Text File  |  1992-01-28  |  17.1 KB  |  345 lines
  1. (vmon)
  2.  
  3. (defun inwerr(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 "pickbox" pib)
  12.    (setvar "cmdecho" 1)
  13.    (setq *error* oer)
  14.    (princ)
  15. )
  16.  
  17. (setq wmes1 "C-1" whgt "900")
  18.  
  19. (defun C:INSWIN(/ rn wlist oer pib x fg loop lop llp lp lpp p insp p1 p2 p3 p4 p5 p6 p7 p8 int1 int2 pins sp ep sp1 ep1 sp2 ep2 sp3 ep3 sp4 ep4 mp mp1 mp2 sn sn1 sn2 en en1 ename ename1 elay elay1 ang ang1 iang wname insx insy insz insz0 
  20. wlength whight wthick xh one one0 o1 o2 o3 o4 mc wlt l n n0 kword pl a1 a2 d1 d2 bn batt r1 r2 r3 r4 sa1 ea1 dr ma1 ss)
  21.    (setvar "CMDECHO" 0)
  22.    (setq pib (getvar "pickbox"))
  23.    (setq loop t fg t oer *error* *error* inwerr)
  24.    (while loop
  25.    (princ "\n┴╨▒φ?/╫░╚δL/┤µ┼╠S/╘∞▒φM/┤░╠¿╕▀H/═╦│÷X/├┼┤░╨┼╧ó\n╚▒╩í <")
  26.    (princ wmes1)
  27.    (initget "? L S H M X")
  28.    (setq x (strcase (getstring ">:")))
  29.    (if (/= x "") (setq wmes1 x))
  30.    (inswin0)
  31.    )
  32.    (inswin1)
  33.    (command "layer" "s" "0" "")
  34.    (setvar "pickbox" pib)
  35.    (setvar "CMDECHO" 1)
  36.    (setq *error* oer)
  37.    (princ)
  38. )
  39.  
  40. (defun inswin0()
  41.    (cond
  42.         ((= wmes1 "H") (princ "\n┤░╠¿╕▀ <")
  43.                       (princ whgt)
  44.                       (setq x (getstring ">: "))
  45.                       (if (/= x "") (setq whgt x)) )
  46.         ((= wmes1 "L") (setq lop t)
  47.                       (while lop
  48.                       (setq fnm (getstring "\n╬─╝■├√: "))
  49.                       (if (findfile (strcat fnm ".mc")) (progn
  50.                       (setq mclist nil)
  51.                       (setq f (open (strcat fnm ".mc") "r"))
  52.                       (while (/= (setq rn (read-line f)) nil)
  53.                          (strdv rn)
  54.                          (setq mclist (cons wlist mclist))
  55.                       )
  56.                     (close f)
  57.                       (setq lop nil))
  58.                       (princ "**╬─╝■├╗╒╥╡╜!**"))
  59.                       ))
  60.          ((= wmes1 "S") (setq lop t)
  61.                        (while lop
  62.                        (setq fnm (getstring "\n╬─╝■├√: "))
  63.                        (if (findfile (strcat fnm ".mc")) (progn
  64.                        (initget "Y N")
  65.                        (setq x (getkword "**╬─╝■╥╤┤µ╘┌, ╓╪╨┤┬≡ <N>**"))
  66.                        ) (setq x "Y"))
  67.                       (if (= x "Y") (progn
  68.                        (setq f (open (strcat fnm ".mc") "w"))
  69.                        (setq n 0 l (length mclist))
  70.                        (repeat l
  71.                          (setq one (nth n mclist))
  72.                          (write-line (strcat (nth 0 one) " " (nth 1 one) " " (nth 2 one) " " (nth 3 one)) f)
  73.                          (setq n (1+ n))
  74.                       )
  75.                       (close f)
  76.                       (setq lop nil)
  77.                       ))
  78.                       ) )
  79.          ((= wmes1 "M") (princ "\n├┼┤░╨═║┼ <C-1>:")
  80.                        (setq x (strcase (getstring)))
  81.                        (if (= x "") (setq xh "C-1") (setq xh x))
  82.                        (if (setq one (assoc xh mclist)) (progn
  83.                        (setq lop t)
  84.                        (while lop
  85.                        (princ "\n├┼┤░╩²╛▌ <")
  86.                        (setq one0 (cdr one) o1 (nth 0 one0) o2 (nth 1 one0) o3 (nth 2 one0))
  87.                        (princ (setq mc (strcat (strcase o1) "=" o2 "*" o3)))
  88.                        (setq x (strcase (getstring ">:")))
  89.                        (if (= x "") (setq mc mc) (setq mc x))
  90.                        (inchkmc mc)
  91.                       )
  92.                       (setq mclist (subst (cons xh wlt) one mclist))
  93.                       )
  94.                       (progn ;else
  95.                       (setq lop t)
  96.                       (while lop
  97.                       (while (= (setq x (strcase (getstring "\n├┼┤░╩²╛▌:"))) ""))
  98.                       (inchkmc x))
  99.                       (setq mclist (cons (cons xh wlt) mclist))
  100.                       )
  101.                       ) ;endif
  102.                      ) ;end cond1
  103.          ((= wmes1 "?") (setq l (length mclist) n 0)
  104.                        (setq wmes "N")
  105.                        (if (> l 0) (progn
  106.                        (princ "\n**╨═║┼ ┐Θ├√ ┐φ╢╚ ╕▀╢╚ **")
  107.                        (repeat l
  108.                           (setq x (nth n mclist))
  109.                           (princ "\n   ")
  110.                           (setq n0 0)(repeat (length x) (princ (read (nth n0 x))) (princ " ") (setq n0 (1+ n0)))
  111.                           (setq n (1+ n))
  112.                        ))
  113.                       (princ "\n*├┼┤░▒φ╓╨╬▐╩²╛▌*")
  114.                       ))
  115.       ((= wmes1 "X") (setq loop nil fg nil))
  116.          (t (if (assoc wmes1 mclist) (setq loop nil) (princ "*├╗╒╥╡╜╕├├┼┤░*")))
  117.    )
  118. )
  119.  
  120. (defun inswin1()
  121.    (if fg (progn
  122.    (setq loop t)
  123.    (while loop
  124.       (setq sn (car (entsel "\n╤í╘±═Γ╟╜╧▀╗≥├┼┤░:")))
  125.       (if sn (progn
  126.       (setq en (entget sn) ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  127.       (if (and (or (= "LINE" ename) (= "ARC" ename)) (= "PWALL" (substr elay 1 5)))
  128.           (progn
  129.           (setq lp t)
  130.           (while lp
  131.           (setq sn1 (car (entsel "\n╤í╘±─┌╟╜╧▀:")))
  132.           (if sn1 (progn
  133.           (setq en1 (entget sn1) ename1 (cdr (assoc 0 en1)) elay1 (cdr (assoc 8 en1)))
  134.           (if (and (or (= "LINE" ename1) (= "ARC" ename1)) (= "PWALLN" elay1))
  135.               (progn
  136.               (if (or (and (= "LINE" ename) (= "LINE" ename1)) (and (= "ARC" ename) (= "ARC" ename1))) 
  137.               (if (and (= "LINE" ename) (= "LINE" ename1)) (progn
  138.               (setq one (assoc wmes1 mclist) one0 (cdr one))
  139.               (setq wname (nth 0 one0) wlength (atoi (nth 1 one0)) whight (nth 2 one0))
  140.               (setq insx (/ wlength 100.0))
  141.               (setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)))
  142.               (setq ang (angle p1 p2) iang (/ (* 180 ang) pi))
  143.               (setq p3 (cdr (assoc 10 en1)) p4 (cdr (assoc 11 en1)))
  144.               (setq ang1 (angle p3 p4) p5 (polar p3 ang1 (/ (distance p3 p4) 2.0)) p6 (polar p5 (+ ang1 1.57079) 100) int1 (inters p1 p2 p5 p6 nil) wthick (fix (+ 0.5 (distance p5 int1))))
  145.               (if (= (substr wname 1 2) "CC") (setq insy (/ wthick 10.0)) (setq insy insx whgt "0"))
  146.               (setq kword (strcase (getstring "\n╒█╜╟┤░Z/▓╬┐╝╡πR/<▓σ╚δ╡π>:")))
  147.               (if (or (= kword "") (= kword "R")) (progn
  148.               (if (eq kword "R") (progn
  149.               (setq p (getpoint "\n▓╬┐╝╡π:"))
  150.               (setq insp (polar p ang (/ wlength 2.0)))
  151.               (command "insert" wname insp "xyz" insx insy 0.01 iang 0)
  152.               (setq sn2 (entlast))
  153.               (princ "\n▓σ╚δ╡π:")
  154.               (command "move" sn2 "" p pause)
  155.               ) ;progn
  156.               (progn ;else
  157.               (princ "\n▓σ╚δ╡π:")
  158.               (command "insert" wname "x" insx "y" insy "z" 0.01 "r" iang pause 0)
  159.               (setq sn2 (entlast))
  160.               )) ;endif 
  161.               (setq p (cdr (assoc 10 (entget sn2))))
  162.               (setq p5 (polar p (+ ang 1.57079) 50))
  163.               (setq int1 (inters p1 p2 p p5 nil) int2 (inters p3 p4 p p5 nil))
  164.               (setq pins (polar int1 (+ ang 1.57079) (/ wthick 2.0)))
  165.               (entdel sn2)
  166.               (setq p1 (polar int1 ang (/ wlength 2)) p2 (polar int1 (+ ang pi) (/ wlength 2)))
  167.               (setq p3 (polar int2 ang1 (/ wlength 2)) p4 (polar int2 (+ ang1 pi) (/ wlength 2)))
  168.               (command "break" sn p1 p2)
  169.               (command "break" sn1 p3 p4)
  170.               (command "layer" "m" "pwindow" "")
  171.               (command "line" p1 p3 "")
  172.               (command "line" p2 p4 "")
  173.               (command "insert" wname pins "xyz" insx insy 0.01 iang (strcat wmes1 " " (itoa wlength) " " whight " " whgt " " (itoa wthick)))
  174.               (setq lp nil)
  175.               ) ;progn ZHE JIAO
  176.               (progn ;else
  177.               (setq p1 (getpoint "\n┤░╞≡╡π:") pl nil pl (cons p1 pl))
  178.               (while (< (length pl) 4)
  179.                   (initget "Undo")
  180.                   (setq p2 (getpoint p1 "\n╗╪═╦Undo/<┤░╧┬╥╗╡π>:"))
  181.                   (if (= p2 "Undo") (progn
  182.                   (if (= (length pl) 1) (princ "*▓╗─▄╘┘╗╪═╦*") (setq pl (cdr pl) p1 (car pl))) )
  183.                   (setq pl (cons p2 pl) p1 p2))
  184.                ) ;end while
  185.               (setq p4 (nth 0 pl) p3 (nth 1 pl) p2 (nth 2 pl) p1 (nth 3 pl) d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p4 p3))
  186.               (setq p5 (polar p1 a1 (/ d1 3.0)) p6 (polar p4 a2 (/ d2 3.0)))
  187.               (setq p7 (polar p2 (+ a1 pi) (/ d1 3.0)) p8 (polar p3 (+ a2 pi) (/ d2 3.0)))
  188.               (setq sn2 nil sn2 (ssadd) insp (inters p1 p3 p2 p4))
  189.               (command "break" sn1 p1 p4)
  190.               (command "break" sn p2 p3)
  191.               (command "layer" "m" "pwindow" "")
  192.               (command "line" p2 p1 "" "line" p3 p4 "")
  193.               (command "color" 2)
  194.               (command "line" p1 p4 "")
  195.               (ssadd (entlast) sn2)
  196.               (command "line" p5 p6 "")
  197.               (ssadd (entlast) sn2)
  198.               (command "line" p7 p8 "")
  199.               (ssadd (entlast) sn2)
  200.               (command "line" p2 p3 "")
  201.               (ssadd (entlast) sn2)
  202.              (command "color" "bylayer")
  203.               (setvar "aflags" 1)
  204.               (command "attdef" "" "x" "" "" "s" "standard" insp (* (getvar "userr1") 3) 0)
  205.               (ssadd (entlast) sn2)
  206.               (command "attdef" "" "x1" "" "" insp (* (getvar "userr1") 3) 0)
  207.               (ssadd (entlast) sn2) 
  208.               (setq bn (strcat "CCZ" (rtos (car insp) 2 0) (rtos (cadr insp) 2 0)))
  209.               (command "block" bn insp sn2 "")
  210.               (setq batt (strcat wmes1 " " (rtos (car p1) 2 4) " " (rtos (cadr p1) 2 4) " " (rtos (car p2) 2 4) " " (rtos (cadr p2) 2 4) " " (rtos (car p3) 2 4) " " (rtos (cadr p3) 2 4) " " (rtos (car p4) 2 4) " " (rtos (cadr p4) 2 4)))
  211.               (command "insert" bn insp "xyz" 1 1 1 0 (strcat wmes1 " " (itoa (fix (distance p2 p3))) " " whight " " whgt " " (itoa wthick)) (strcat batt " " (rtos (angle p2 p3) 2 4)))
  212.               (setq lp nil)
  213.               ));endif
  214.               ) ;and "Line"
  215.               (progn ;and "Arc"
  216.               (setq lpp t one (assoc wmes1 mclist) one0 (cdr one))
  217.               (setq wname (nth 0 one0) wlength (atoi (nth 1 one0)) whight (nth 2 one0))
  218.               (while lpp
  219.               (initget "Undo X")
  220.               (setq sp (getpoint "\n╗╪═╦U/═╦│÷X/<├┼┤░╞≡╡π>:"))
  221.               (cond ((= "Undo" sp) (command "undo" "end" "u"))
  222.                     ((= "X" sp) (setq lpp nil lp nil))
  223.               (t (setvar "coords" 2)
  224.               (setq ep (getpoint sp "\n├┼┤░╓╒╡π:"))
  225.               (setvar "coords" 0)
  226.               (command "undo" "g")
  227.               (setq insp (cdr (assoc 10 en)) r1 (cdr (assoc 40 en)) r2 (cdr (assoc 40 en1)) wthick (fix (+ 0.5 (- r1 r2))))
  228.               (setq sa1 (angle insp sp) ea1 (angle insp ep) ma1 (- ea1 sa1))
  229.               (if (< ma1 0) (setq ma1 (+ sa1 (/ (+ (* 2 pi) ma1) 2.0))) (setq ma1 (+ sa1 (/ ma1 2.0))))
  230.               (setq sp1 (polar insp sa1 r1) ep1 (polar insp ea1 r1))
  231.               (setq sp2 (polar insp sa1 r2) ep2 (polar insp ea1 r2))
  232.               (setq mp1 (polar insp ma1 r1) mp2 (polar insp ma1 r2))
  233.               (setq mp (polar mp2 (angle mp2 mp1) (/ (- r1 r2) 2.0)))
  234.               (setvar "pickbox" 1)
  235.               (setq sn1 (ssname (ssget mp1) 0))
  236.               (setq sn2 (ssname (ssget mp2) 0))
  237.               (setvar "pickbox" pib)
  238.               (command "break" sn1 sp1 ep1)
  239.               (command "break" sn2 sp2 ep2)
  240.               (command "layer" "m" "pwindow" "")
  241.               (command "line" sp1 sp2 "" "line" ep1 ep2 "")
  242.               (setq dr (/ (- r1 r2) 3.0) r3 (+ r2 dr) r4 (- r1 dr))
  243.               (setq sp3 (polar insp sa1 r3) ep3 (polar insp ea1 r3))
  244.               (setq sp4 (polar insp sa1 r4) ep4 (polar insp ea1 r4))
  245.               (if (= (substr (setq bn (nth 1 one)) 1 2) "CC") (progn
  246.               (setq sn nil sn (ssadd))
  247.               (command "color" 2)
  248.               (command "arc" sp3 "c" insp ep3)
  249.               (ssadd (entlast) sn)
  250.               (command "arc" sp4 "c" insp ep4)
  251.               (ssadd (entlast) sn)
  252.               (command "arc" sp1 "c" insp ep1)
  253.               (ssadd (entlast) sn)
  254.               (command "arc" sp2 "c" insp ep2)
  255.               (ssadd (entlast) sn)
  256.               (command "color" "bylayer")
  257.               (setvar "aflags" 1)
  258.               (command "attdef" "" "x" "" "" "s" "standard" mp1 (* 3 (getvar "userr1")) 0)
  259.               (ssadd (entlast) sn)
  260.               (command "attdef" "" "x1" "" "" mp1 (* 3 (getvar "userr1")) 0)
  261.               (ssadd (entlast) sn)
  262.               (setq bn (strcat "CCA" (rtos (car mp) 2 0) (rtos (cadr mp) 2 0)))
  263.               (command "block" bn mp sn "")
  264.               (setq batt (strcat wmes1 " " (itoa (fix (distance sp1 ep1))) " " whight " " whgt " " (itoa wthick)))
  265.               (command "insert" bn mp "xyz" 1 1 1 0 batt (strcat wmes1 " " (rtos sa1 2 4) " " (rtos ea1 2 4) " " (rtos r1 2 4) " " (rtos r2 2 4) " " whight " " whgt " " (itoa wthick) " " (rtos (angle sp1 ep1) 2 4)))
  266.               ) ;endprogn "CC"
  267.               (progn
  268.                      (setq sn (entlast) ss nil ss (ssadd) whgt "0")
  269.                      (command "insert" bn mp (/ (distance sp3 ep3) 100.0) "" (/ (* (angle sp3 ep3) 180.0) pi) "")
  270.                      (command "explode" (entlast))
  271.                      (while (/= (setq sn (entnext sn)) nil) (ssadd sn ss))
  272.                      (setvar "aflags" 1)
  273.                      (command "attdef" "" "x1" "" "" mp1 (* 3 (getvar "userr1")) 0)
  274.                      (ssadd (entlast) ss)
  275.                      (setq bn (strcat "CCA" (rtos (car mp) 2 0) (rtos (cadr mp) 2 0)))
  276.                      (command "block" bn mp ss "")
  277.                      (setq x (strcat wmes1 " " (itoa (fix (distance sp1 ep1))) " " (nth 3 one) " " whgt " " (itoa wthick)))
  278.                      (setq x1 (strcat wmes1 " " (rtos sa1 2 4) " " (rtos ea1 2 4) " " (rtos r1 2 4) " " (rtos r2 2 4) " " (nth 3 one) " " whgt " " (itoa wthick) " " (rtos (angle sp1 ep1) 2 4)))
  279.                      (command "insert" bn mp "xyz" 1 1 0.01 0 x x1)
  280.               )) ;endif
  281.               )) ;endcond "t"
  282.               ) ;endwhile lpp
  283.               )) ;endif and arc
  284.               (princ "*╦∙╤í╟╜╧▀▓╗╥╗╓┬*")
  285.               ) ;endif and arc line
  286.               )(princ "╤í╘±╡─▓╗╩╟╟╜╧▀!")) ;if "LINE"
  287.               )(setq lp nil loop nil)) ;if sn1
  288.               ) ;end while
  289.               ) ;endprogn if "LINE"
  290.               (progn
  291.               (if (and (= ename "INSERT") (= elay "PWINDOW")) (progn
  292.               (setq pins (cdr (assoc 10 en)) rn (cdr (assoc 1 (setq en1 (entget (setq sn1 (entnext sn)))))) iang (/ (* 180.0 (cdr (assoc 50 en))) pi))
  293.               (strdv rn) (setq insz0 (rtos (+ (atoi (nth 2 wlist)) (atoi (nth 3 wlist))) 2 0))
  294.               (setq one (assoc wmes1 mclist) wname (nth 1 one) whight (nth 3 one))
  295.               (setq wlength (nth 1 wlist) wthick (nth 4 wlist) insx (/ (atoi wlength) 100.0))
  296.              (setq bn (cdr (assoc 2 en)))
  297.               (if (= "CC" (substr bn 1 2)) (setq insy (/ (atoi wthick) 10.0)) (setq insy insx))
  298.               (if (or (= "CCA" (substr bn 1 3)) (= "CCZ" (substr bn 1 3))) (setq insx 1 insy insx wname bn x1 (cdr (assoc 1 (entget (entnext (setq sn1 (entnext sn)))))) en1 (entget sn1) rn (cdr (assoc 1 en1))))
  299.               (setq en1 (subst (cons 1 (strcat rn " " whgt "$")) (assoc 1 en1) en1))
  300.               (entmod en1)
  301.               (command "layer" "m" "pwindow" "")
  302.               (if (or (= "CCA" (substr bn 1 3)) (= "CCZ" (substr bn 1 3)))
  303.               (command "insert" wname pins "xyz" insx insy 0.01 iang (strcat wmes1 " " wlength " " whight " " whgt " " wthick " " insz0 "@") x1)
  304.               (command "insert" wname pins "xyz" insx insy 0.01 iang (strcat wmes1 " " wlength " " whight " " whgt " " wthick " " insz0 "@")) ) ;if
  305.               )
  306.               (princ "\n*╤í╘±╡─▓╗╩╟├┼┤░╗≥╟╜╧▀*")
  307.               )
  308.               )) ;endif "LINE"
  309.               )(setq loop nil)) ;if sn
  310.               ) ;end while
  311.    )) ;endif fg
  312. )
  313.  
  314. (defun instr(st s0 s00 / l n loop x n0 l0)
  315.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  316.    (while (and (<= n l) loop)
  317.       (setq x (substr s0 n0 1))
  318.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  319.    )
  320.    (eval l0)
  321. )
  322.  
  323. (defun inchkmc(c / l0 l1 l2 xh0 wd hgt ch)
  324.    (setq wlt nil)
  325.    (if (and (> (setq l0 (instr 1 c "=")) 0) (> (setq l1 (instr 1 c "*")) 0) (= (setq l2 (instr 1 c "@")) 0) (> l1 l0)) (progn
  326.    (setq xh0 (substr c 1 (- l0 1)) wd (substr c (+ l0 1) (- l1 l0 1)) hgt (substr c (+ l1 1)))
  327.    (if (and (findfile (strcat xh0 ".dwg")) (> (atoi wd) 0) (> (atoi hgt) 0)) (setq lop nil wlt (list xh0 wd hgt)) (princ "*│÷┤φ*"))) (princ "*│÷┤φ*"))
  328. )
  329.  
  330. (defun strdv(rn / loop l x)
  331.        (setq wlist nil loop t)
  332.        (while loop
  333.           (setq l (instr 1 rn " "))
  334.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  335.              (progn ;else
  336.              (setq x (substr rn 1 (1- l)))
  337.              (setq wlist (cons x wlist))
  338.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  339.              (setq loop t)
  340.              )
  341.           )
  342.        )
  343.        (setq wlist (reverse wlist))
  344. )
  345.