home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 15.img / AME2.LIB / STLSUP.LSP < prev   
Encoding:
Text File  |  1992-09-10  |  7.7 KB  |  254 lines
  1. ;;;   STLSUP.lsp
  2. ;;;   ¬⌐┼v (C) 1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;;   ¡∞½h :
  6. ;;;
  7. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;   By Rick Barrientos
  15. ;;;   Thanks to Duff Kurland and Simon Jones who may recognize part of 3D.lsp
  16. ;;;   in this program.
  17. ;;;   Version 0.3               2 January 1992
  18. ;;;
  19. ;;;----------------------------------------------------------------------------;
  20. ;;;
  21. ;;;   DESCRIPTION
  22. ;;;
  23. ;;;   STLSUP.LSP is a sample AME 2.0 lisp routine.
  24. ;;;
  25. ;;;   It allows automatic creation of common Stereo Lithography support
  26. ;;;   structures. AME 2.0 supports STL output. This program is intended
  27. ;;;   to be used in conjunction with this feature.
  28. ;;;
  29. ;;;   The program is loaded and called by typing "stlsup". The user is
  30. ;;;   then prompted to select a star or eggcrate type support structure.
  31. ;;;
  32. ;;;   To create a star shaped support structure, the user must input a
  33. ;;;   base center point, a diameter or radius, and a height for
  34. ;;;   the overall structure. A cylinder will temporarily be drawn
  35. ;;;   indicating the overall dimensions of the structure. The user must
  36. ;;;   now input the number of segments to create and the wall thickness
  37. ;;;   for the web. The structure is then generated.
  38. ;;;
  39. ;;;   To create an eggcrate shaped support structure, the user must
  40. ;;;   input a corner, a length along the X axis, a width along the
  41. ;;;   Y axis, and a height along the Z axis.There is an option to
  42. ;;;   draw a cube and only input one distance. A box will temporarily
  43. ;;;   be drawn indicating the overall dimensions of the structure. The
  44. ;;;   user must now input the spacing and wall thickness for the web.
  45. ;;;   The structure is then generated.
  46.  
  47. ;Draw a star shaped stl support structure
  48. (defun star (/ numseg elev cen cen1 rad ang p1 p2 p3 h webt)
  49.    (setq numseg 0)
  50.    (initget 17)                       ;3D point can't be null
  51.    (setq elev (caddr (setq cen (getpoint "\níu¼P¬¼ñΣ⌐╙ívñññ▀┬I: "))))
  52.    (initget 7 "Diameter")             ;Base radius can't be 0, neg, or null
  53.    (setq rad (getdist cen "\níu¼P¬¼ñΣ⌐╙ívD¬╜«|/<Ñb«|> : "))
  54.    (if (= rad "Diameter")
  55.       (progn
  56.          (initget 7)                  ;Base diameter can't be 0, neg, or null
  57.          (setq rad (/ (getdist cen "\níu¼P¬¼ñΣ⌐╙ív¬╜«|: ") 2.0))
  58.       )
  59.    )
  60.  
  61.    (setq ang 0)
  62.    (setq p1 (polar cen ang rad))
  63.    (repeat 16
  64.       (setq ang (+ ang (/ (* 2 pi) 16)))
  65.       (setq p2 (polar cen ang rad))
  66.       (grdraw p1 p2 2)
  67.       (setq p1 p2)
  68.    )
  69.  
  70.  
  71.  
  72.    (initget 7 "Height")               ;Height can't be 0, neg, or null
  73.    (setq h (getdist cen "\nH░¬½╫: "))
  74.    (setq cen1 (list (car cen) (cadr cen) (+ (caddr cen) h)))
  75.    (setq ang 0)
  76.    (setq p1 (polar cen1 ang rad))
  77.     (repeat 16
  78.       (setq ang (+ ang (/ (* 2 pi) 16)))
  79.       (setq p2 (polar cen1 ang rad))
  80.       (setq p3 (list (car p1) (cadr p1) (- (caddr p1) h)))
  81.       (grdraw p1 p3 2)
  82.       (grdraw p1 p2 2)
  83.       (setq p1 p2)
  84.     )
  85.  
  86.  
  87.  
  88.    (while (< numseg 2)                ;number of segs in radial array
  89.       (initget 6)
  90.       (setq numseg (getint "\n║c¡▒╝╞╢q <8>: "))
  91.       (if (null numseg)
  92.          (setq numseg 8)
  93.       )
  94.       (if (< numseg 2)
  95.          (princ "\níu║c¡▒╝╞╢qívÑ▓╢╖ > 1 íC")
  96.       )
  97.    )
  98.  
  99.    (initget 6)
  100.    (setq webt (getreal "\n║c¬O½p½╫ <0.020>: "))
  101.       (if (= webt nil) (setq webt 0.020))
  102.  
  103.    (setq a (list (car cen) (- (cadr cen) (/ webt 2)) (caddr cen)))
  104.    (setq ss (ssadd))
  105.    (ssadd (SOLBOX  a "l" rad webt h) ss)
  106.    (setq x (entlast))
  107.    (command "_.array" "_l" "" "_p" cen numseg "360" "")
  108.       (repeat numseg
  109.          (ssadd x ss)
  110.          (setq x (entnext x))
  111.  
  112.       )
  113.    (SOLUNION ss)
  114.    (redraw)
  115.    (princ)
  116.  
  117. )
  118.  
  119. ;Draw a eggcrate style stl support structure
  120. (defun eggcrate (/ pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 l w h1 h2
  121.                    webs webt num mod p)
  122.    (initget 17)                       ;3D point can't be null
  123.    (setq pt1 (getpoint "\níu│J¼[ñΣ⌐╙ív¿ñ┬I: "))
  124.    (setvar "ORTHOMODE" 1)
  125.    (initget 7)                        ;Length can't be 0, neg, or null
  126.    (setq l (getdist pt1 "\n(¬u X ╢bªV╢Z┬≈) ¬°½╫: "))
  127.    (setq pt3 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  128.    (grdraw pt1 pt3 2)
  129.  
  130.    (initget 7 "Cube")        ;Width can't be 0, neg, or null
  131.    (setq w (getdist pt1 "\nCÑ┐Ñ▀ñΦñΣ⌐╙/(¬u Y ╢bªV╢Z┬≈) <╝e½╫>: "))
  132.       (if (= w "Cube")
  133.       (setq w l h1 l h2 l)
  134.       )
  135.  
  136.    (setq pt2 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  137.    (setq pt4 (list (car pt3) (+ (cadr pt3) w) (caddr pt3)))
  138.    (grdraw pt3 pt4 2)
  139.    (grdraw pt4 pt2 2)
  140.    (grdraw pt2 pt1 2)
  141.    (setvar "ORTHOMODE" 0)
  142.  
  143.       (if (/= h1 l)
  144.       (progn
  145.       (initget 7)        ;Height can't be 0, neg, or null
  146.       (setq h1 (getdist pt1 "\n(¬u Z ╢bªV╢Z┬≈) ░¬½╫: "))
  147.       (setq h2 h1)))
  148.  
  149.    (setq pt5 (list (car pt3) (cadr pt3) (+ (caddr pt3) h2)))
  150.    (setq pt6 (list (car pt4) (cadr pt4) (+ (caddr pt4) h2)))
  151.    (setq pt7 (list (car pt1) (cadr pt1) (+ (caddr pt1) h1)))
  152.    (setq pt8 (list (car pt2) (cadr pt2) (+ (caddr pt2) h1)))
  153.  
  154.    (grdraw pt5 pt3 2)
  155.    (grdraw pt7 pt1 2)
  156.    (grdraw pt8 pt2 2)
  157.    (grdraw pt6 pt4 2)
  158.    (grdraw pt5 pt7 2)
  159.    (grdraw pt7 pt8 2)
  160.    (grdraw pt8 pt6 2)
  161.    (grdraw pt6 pt5 2)
  162.  
  163.    (initget 6)
  164.    (setq webs (getreal "\n¬Oñ▀╢í╢Z <0.375>: "))
  165.       (if (= webs nil) (setq webs 0.375))
  166.    (initget 6)
  167.    (setq webt (getreal "\n║c¬O½p½╫ <0.020>: "))
  168.       (if (= webt nil) (setq webt 0.020))
  169.  
  170. (if (or (> (+ webs webt) l) (> (+ webs webt) l))
  171.  (progn
  172.    (princ "\n─╡ºi í╨íu║c¬O╢í╢Zív╗Píu½p½╫ív╢W╣L┴`ñ╪ñoíC")
  173.    (princ "\n╡L¬k½╪Ñ▀ STL ╡▓║c; ╜╨ªA╕╒íC")
  174.  )
  175.  (progn
  176.    (setq num (fix (/ l webs)))
  177.    (setq mod (- l (+ webt (* webs (- num 1)))))
  178.    (setq ss (ssadd))
  179.    (ssadd (SOLBOX pt1 "l" webt w h1) ss)
  180.    (setq x (entlast))
  181.    (setq p (list (+ (car pt1) (/ mod 2)) (cadr pt1) (caddr pt1)))
  182.    (command "_.move" "_l" "" pt1 p)
  183.       (if (/= 1 num)
  184.          (command "_.array" "_l" "" "_r" "" num webs)
  185.       )
  186.       (repeat num
  187.          (ssadd x ss)
  188.          (setq x (entnext x))
  189.       )
  190.    (setq num (fix (/ w webs)))
  191.    (setq mod (- w (+ webt (* webs (- num 1)))))
  192.    (ssadd (SOLBOX pt1 "l" l webt h1) ss)
  193.    (setq x (entlast))
  194.    (setq p (list (car pt1) (+ (cadr pt1) (/ mod 2)) (caddr pt1)))
  195.    (command "_.move" "_l" "" pt1 p)
  196.       (if (/= 1 num)
  197.          (command "_.array" "_l" "" "_r" num "" webs)
  198.       )
  199.       (repeat num
  200.          (ssadd x ss)
  201.          (setq x (entnext x))
  202.  
  203.       )
  204.  
  205.    (SOLUNION ss)
  206.  )
  207. )
  208.    (redraw)
  209.    (princ)
  210.  
  211. )
  212. ;option function
  213. ;act is a global variable so function will remember last option
  214. (defun inpt(/ acte)
  215.  
  216.         (initget "Star Eggcrate")
  217.         (if (= act "Star")
  218.         (princ "\nE│J¼[ñΣ⌐╙/<S¼P¬¼ñΣ⌐╙>: "))
  219.         (if (/= act "Star")
  220.           (progn
  221.             (setq act "Eggcrate")
  222.             (princ "\nS¼P¬¼ñΣ⌐╙/<E│J¼[ñΣ⌐╙>: ")
  223.           )
  224.         )
  225.         (setq acte (getkword))
  226.         (if (= acte nil) (setq acte act))
  227.         (setq act acte)
  228.         (if (= act nil) (setq act "Eggcrate"))
  229.         (if (= act "Star") (star))
  230.         (if (= act "Eggcrate") (eggcrate))
  231. )
  232. ;error handler
  233. (defun *error* (msg)
  234.         (princ "┐∙╗~: ")
  235.         (princ msg)
  236.         (redraw)
  237.         (princ)
  238. )
  239. ;main function
  240. (defun c:stlsup( / quit)
  241.   (setq quit 0)
  242.   (setvar "cmdecho" 0)
  243.       (if (not SOLBOX)
  244.         (progn
  245.         (princ "\n░⌡ªµª╣Ñ\»αñº½e, Ñ▓╢╖Ѳ╕ⁿñJ AME 2.0 ╢∞½¼╡{ªííC")
  246.         (setq quit 1))
  247.       )
  248.   (if (/= quit 1) (inpt))
  249.   (setvar "cmdecho" 1)
  250.   (setq ss nil)
  251.   (princ)
  252. )
  253.  
  254.