home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / FA / 3DRXLT.LSP < prev    next >
Encoding:
Text File  |  1989-10-17  |  4.7 KB  |  163 lines
  1. ;******FA\3DRXLT.LSP****** 10-17-89
  2. (defun C:3DARC ( )
  3.   (parc0)
  4.   (setq wcy 1)
  5.   (while wcy
  6.     (setq wxr (getstring "\n Rx/JM/JX/Sx/ZU/ZI/Lim
  7.       <or RETURN for none>:"))
  8.       (if (= wxr "") (setq wcy nil))
  9.       (if (= (substr wxr 1 1) "R") (rx))
  10.       (if (= (substr wxr 1 2) "JM") (jm))
  11.       (if (= (substr wxr 1 2) "JX") (jx))
  12.       (if (= (substr wxr 1 1) "S") (sx))
  13.       (if (= (substr wxr 1 2) "ZU") (lzu))
  14.       (if (= (substr wxr 1 2) "ZI") (lzui))
  15.       (if (= (substr wxr 1 1) "L") (larc))
  16.     (if (/= wxr "") (rparc0))
  17.   )
  18. )
  19. (defun ests ( )
  20.   (setvar "elevation" se)
  21.   (setvar "thickness" st)
  22. )
  23. (defun e0t0 ( )
  24.   (setq se (getvar "elevation"))
  25.   (setq st (getvar "thickness"))
  26.   (setvar "elevation" 0.0)
  27.   (setvar "thickness" 0.0)
  28. )
  29. (defun parc0 ( )
  30.   (setq c1 (getpoint "\n enter point c1:"))
  31.     (setq xc (car c1) yc (cadr c1))
  32.   (command "text" c1 (* 500 tb) 0.0 "C1")
  33.   (setq hc (getdist "\n enter height hc <0>:" c1))
  34.     (if (null hc) (setq hc 0.0))
  35.   (setq rmin (getdist "\n enter Rmin:" c1))
  36.   (setq rmax (getdist "\n enter Pmax:" c1))
  37.   (setq aa (getreal "\n enter angle AA<360>:"))
  38.     (if (null aa) (setq aa 360)) (setq aa (* pi (/ aa 180)))
  39.   (setq n (getint "\n enter int n:"))
  40.     (setq an (/ aa n)) (setq n (+ n 1))
  41.   (setq a1 (getangle "\n enter angle A1<0>:" c1))
  42.     (if (null a1) (setq a1 0))
  43. )
  44. (defun rparc0 ( )
  45.   (setq nr (getdist "\n enter new r <old>:" c1))
  46.     (if (null nr) (setq nr r) (setq r nr))
  47.   (setq nhc (getdist "\n enter new hc <old>:" c1))
  48.     (if (null nhc) (setq nhc hc) (setq hc nhc))
  49. )
  50. (defun sx (/ caf)
  51.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  52.     (if (null h12) (setq h12 0.0))
  53.   (setq dh (getreal "\n enter height of SX:"))
  54.   (e0t0) (setvar "thickness" dh)
  55.   (setq k 0)
  56.   (while (> n k)
  57.     (setq caf (+ a1 (* an k)))
  58.     (setvar "elevation" (+ (* k h12) hc))
  59.     (command "point" (polar c1 caf r))
  60.     (setq k (1+ k))
  61.   )
  62.   (ests)
  63. )
  64. (defun rx01 (/ caf 3dpx 3dpy 3dph)
  65.     (setq caf (+ (* k an) a1))
  66.     (setq 3dp (polar c1 caf r))
  67.   (setq 3dpx (car 3dp) 3dpy (cadr 3dp))
  68.   (setq 3dph (+ hc (* k h12)))
  69.   (setq 3dp (list 3dpx 3dpy 3dph))
  70. )
  71. (defun rx ( )
  72.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  73.     (if (null h12) (setq h12 0.0))
  74.   (setq k 0) (rx01) (setq 3dp1 3dp)
  75.   (setq k 1)
  76.   (while (> n k)
  77.     (rx01) (setq 3dp2 3dp)
  78.     (command "3dline" 3dp1 3dp2 "")
  79.     (prompt "Working...")
  80.     (setq 3dp1 3dp2)
  81.     (setq k (1+ k))
  82.   )
  83. )
  84. (defun larc01 (/ aa saa caa)
  85.   (setq aa (+ (* k an) a1))
  86.   (setq saa (sin aa))
  87.   (setq caa (cos aa))
  88.   (setq 3dp (polar c1 af (* r caa)))
  89.   (setq 3dpx (car 3dp) 3dpy (cadr 3dp))
  90.   (setq 3dph (+ hc (* r saa)))
  91.   (setq 3dp (list 3dpx 3dpy 3dph))
  92. )
  93. (defun larc ( )
  94.   (setq af (getangle "\n enter angle Af<0>:" c1))
  95.     (if (null af) (setq af 0.0))
  96.   (setq k 0) (larc01) (setq 3dp1 3dp)
  97.   (setq k 1)
  98.   (while (> n k)
  99.     (larc01) (setq 3dp2 3dp)
  100.     (command "3dline" 3dp1 3dp2 "")
  101.     (prompt "Working...")
  102.     (setq 3dp1 3dp2)
  103.     (setq k (1+ k))
  104.   )
  105. )
  106. (defun lzu (/ aa1)
  107.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  108.     (if (null h12) (setq h12 0.0))
  109.   (e0t0) (setvar "thickness" h12)
  110.   (setvar "elevation" hc)
  111.   (command "line" (polar c1 a1 r) (polar c1 (+ a1 an) r) "")
  112.   (setq aa1 (* (/ aa pi) 180))
  113.   (command "array" "l" "" "p" c1 n aa1 "")
  114.   (ests)
  115.   )
  116. (defun lzui (/ aa1 hc1)
  117.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  118.     (if (null h12) (setq h12 0.0))
  119.   (setq 3dp1 (list xc yc (+ hc h12)))
  120.   (setq hc1 (list hc))
  121.   (setq 3dp2 (polar c1 a1 r)) (setq 3dp2 (append 3dp2 hc1))
  122.   (setq 3dp3 (polar c1 (+ a1 an) r)) (setq 3dp3 (append 3dp3 hc1))
  123.   (command "3dline" 3dp1 3dp2 3dp3 "")
  124.   (setq aa1 (* (/ aa pi) 180))
  125.   (command "array" "l" 3dp1 "" "p" c1 n aa1 "")
  126.   )
  127. (defun jm (/ caf)
  128.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  129.     (if (null h12) (setq h12 0.0))
  130.   (setq dr (getdist "\n enter real dr:" c1))
  131.   (e0t0) (setvar "thickness" h12)
  132.   (setq k 0)
  133.   (while (> n k)
  134.     (setq caf (+ a1 (* an k)))
  135.     (setvar "elevation" (+ (* k h12) hc))
  136.     (setq 3dp1 (polar c1 caf r))
  137.     (command "line" 3dp1 (polar 3dp1 caf dr) "")
  138.     (setq k (1+ k))
  139.   )
  140.   (ests)
  141. )
  142. (defun jx01 (/ caf 3dpx 3dpy)
  143.   (setq caf (+ (* k an) a1))
  144.   (setq 3dp (polar c1 caf r))
  145.   (setq 3dpx (car 3dp) 3dpy (cadr 3dp))
  146.   (setq 3dp (list 3dpx 3dpy 3dph))
  147. )
  148. (defun jx ( )
  149.   (setq h12 (getdist "\n enter h12 <0>:" c1))
  150.     (if (null h12) (setq h12 0.0))
  151.   (setq k 0) (setq 3dph hc) (jx01) (setq 3dp1 3dp)
  152.   (setq k 1)
  153.   (while (> n k)
  154.     (jx01) (setq 3dp2 3dp)
  155.     (setq 3dph (+ hc (* k h12)))
  156.     (jx01) (setq 3dp3 3dp)
  157.     (command "3dline" 3dp1 3dp2 3dp3 "")
  158.     (prompt "Working...")
  159.     (setq 3dp1 3dp3)
  160.     (setq k (1+ k))
  161.   )
  162. )
  163.