home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 10.img / BONUS3.LIB / SPIRAL.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  4.6 KB  |  136 lines
  1. ;;;   SPIRAL.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. ;;; DESCRIPTION
  15. ;;;
  16. ;;;   This is a programming example.
  17. ;;;
  18. ;;;   Designed and implemented by Kelvin R. Throop in January 1985
  19. ;;;
  20. ;;;   This program constructs a spiral. It can be loaded and called
  21. ;;;   by typing either "spiral", "3dspiral" or the following:
  22. ;;;   (cspiral <# rotations> <base point> <horiz growth per rotation>
  23. ;;;            <points per circle> <start radius>
  24. ;;;            <vert growth per rotation>).
  25. ;;;
  26. ;;; --------------------------------------------------------------------------;
  27.  
  28. (defun myerror (s)                    ; If an error (such as CTRL-C) occurs
  29.                                       ; while this command is active...
  30.   (if (/= s "Function cancelled")
  31.     (princ (strcat "\n┐∙╗~: " s))
  32.   )
  33.   (setvar "cmdecho" ocmd)             ; Restore saved modes
  34.   (setvar "blipmode" oblp)
  35.   (setq *error* olderr)               ; Restore old *error* handler
  36.   (princ)
  37. )
  38.  
  39. (defun cspiral (ntimes bpoint hfac lppass strad vfac
  40.                 / ang dist tp ainc dhinc dvinc circle dv)
  41.  
  42.   (setvar "blipmode" 0)               ; turn blipmode off
  43.   (setvar "cmdecho" 0)                ; turn cmdecho off
  44.   (setq circle (* 3.141596235 2))
  45.   (setq ainc (/ circle lppass))
  46.   (setq dhinc (/ hfac lppass))
  47.   (if vfac (setq dvinc (/ vfac lppass)))
  48.   (setq ang 0.0)
  49.   (if vfac
  50.     (setq dist strad dv 0.0)
  51.     (setq dist 0.0)
  52.   )
  53.   (if vfac
  54.     (command "3dpoly")                ; start spiral ...
  55.     (command "pline" bpoint)          ; start spiral from base point and...
  56.   )
  57.   (repeat ntimes
  58.     (repeat lppass
  59.       (setq tp (polar bpoint (setq ang (+ ang ainc))
  60.                       (setq dist (+ dist dhinc))
  61.                )
  62.       )
  63.       (if vfac
  64.           (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
  65.                 dv (+ dv dvinc)
  66.           )
  67.       )
  68.       (command tp)                    ; continue to the next point...
  69.     )
  70.   )
  71.   (command "")                        ; until done.
  72.   (princ)
  73. )
  74.  
  75. ;;;
  76. ;;;       Interactive spiral generation
  77. ;;;
  78.  
  79. (defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp)
  80.   (setq olderr  *error*
  81.         *error* myerror)
  82.   (setq ocmd (getvar "cmdecho"))
  83.   (setq oblp (getvar "blipmode"))
  84.   (setvar "cmdecho" 0)
  85.   (initget 1)                         ; bp must not be null
  86.   (setq bp (getpoint "\nñññ▀┬I: "))
  87.   (initget 7)                         ; nt must not be zero, neg, or null
  88.   (setq nt (getint "\n▒█┬αª╕╝╞: "))
  89.   (initget 3)                         ; cf must not be zero, or null
  90.   (setq cf (getdist "\n¿Cª╕▒█┬α¬║íu╝W╢qív: "))
  91.   (initget 6)                         ; lp must not be zero or neg
  92.   (setq lp (getint "\n¿Cª╕▒█┬α¿╧Ñ╬¬║íu┬Iív╝╞ <30>: "))
  93.   (cond ((null lp) (setq lp 30)))
  94.   (cspiral nt bp cf lp nil nil)
  95.   (setvar "cmdecho" ocmd)
  96.   (setvar "blipmode" oblp)
  97.   (setq *error* olderr)               ; Restore old *error* handler
  98.   (princ)
  99.  
  100. )
  101.  
  102. ;;;
  103. ;;;       Interactive spiral generation
  104. ;;;
  105.  
  106. (defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp)
  107.   (setq olderr  *error*
  108.         *error* myerror)
  109.   (setq ocmd (getvar "cmdecho"))
  110.   (setq oblp (getvar "blipmode"))
  111.   (setvar "cmdecho" 0)
  112.   (initget 1)                         ; bp must not be null
  113.   (setq bp (getpoint "\nñññ▀┬I: "))
  114.   (initget 7)                         ; nt must not be zero, neg, or null
  115.   (setq nt (getint "\n▒█┬αª╕╝╞: "))
  116.   (initget 7)                         ; sr must not be zero, neg, or null
  117.   (setq sr (getdist bp "\n░_⌐lÑb«|: "))
  118.   (initget 1)                         ; cf must not be zero, or null
  119.   (setq hg (getdist "\n¿Cª╕▒█┬α¬║íuñ⌠Ñ¡╝W╢qív: "))
  120.   (initget 3)                         ; cf must not be zero, or null
  121.   (setq vg (getdist "\n¿Cª╕▒█┬α¬║íu½½¬╜╝W╢qív: "))
  122.   (initget 6)                         ; lp must not be zero or neg
  123.   (setq lp (getint "\n¿Cª╕▒█┬α¿╧Ñ╬¬║íu┬Iív╝╞ <30>: "))
  124.   (cond ((null lp) (setq lp 30)))
  125.   (cspiral nt bp hg lp sr vg)
  126.   (setvar "cmdecho" ocmd)
  127.   (setvar "blipmode" oblp)
  128.   (setq *error* olderr)               ; Restore old *error* handler
  129.   (princ)
  130.  
  131. )
  132.  
  133. ;;; --------------------------------------------------------------------------;
  134. (princ "\n\tíuC:SPIRALív╗PíuC:3DSPIRALívñw╕ⁿñJíC ")
  135. (princ)
  136.