home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / R11SUPP.EXE / SPIRAL.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1990-09-07  |  3.1 KB  |  89 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; SPIRAL.LSP
  3. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  4. ;;;  
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.  
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  9. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  10. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;;
  12. ;;; --------------------------------------------------------------------------;
  13. ;;; DESCRIPTION
  14. ;;;
  15. ;;;   This is a programming example.
  16. ;;;
  17. ;;;   Designed and implemented by Kelvin R. Throop in January 1985
  18. ;;;
  19. ;;;   This program constructs a spiral. It can be loaded and called 
  20. ;;;   by typing either "spiral" or the following:
  21. ;;;   (cspiral <# rotations> <base point> <growth per rotation>
  22. ;;;            <points per circle>).
  23. ;;;
  24. ;;; --------------------------------------------------------------------------;
  25.  
  26. (defun myerror (s)                    ; If an error (such as CTRL-C) occurs
  27.                                       ; while this command is active...
  28.   (if (/= s "Function cancelled")
  29.     (princ (strcat "\nError: " s))
  30.   )
  31.   (setvar "cmdecho" ocmd)             ; Restore saved modes
  32.   (setvar "blipmode" oblp)
  33.   (setq *error* olderr)               ; Restore old *error* handler
  34.   (princ)
  35. )
  36.  
  37.  
  38. (defun cspiral (ntimes bpoint cfac lppass / ang dist tp ainc dinc circle) 
  39.   (setvar "blipmode" 0)               ; turn blipmode off
  40.   (setvar "cmdecho" 0)                ; turn cmdecho off
  41.   (setq circle (* 3.141596235 2))
  42.   (setq ainc (/ circle lppass))
  43.   (setq dinc (/ cfac lppass))
  44.   (setq ang 0.0)
  45.   (setq dist 0.0)
  46.   (command "pline" bpoint)            ; start spiral from base point and...
  47.   (repeat ntimes 
  48.     (repeat lppass 
  49.       (setq tp (polar bpoint (setq ang (+ ang ainc))
  50.                       (setq dist (+ dist dinc))
  51.                ))
  52.       (command tp)                    ; continue to the next point...
  53.     )
  54.   ) 
  55.   (command "")                        ; until done.
  56.   (princ)
  57. ) 
  58.  
  59. ;;;
  60. ;;;       Interactive spiral generation
  61. ;;;
  62.  
  63. (defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp) 
  64.   (setq olderr  *error*
  65.         *error* myerror)
  66.   (setq ocmd (getvar "cmdecho"))
  67.   (setq oblp (getvar "blipmode"))
  68.   (setvar "cmdecho" 0)
  69.   (initget 1)                         ; bp must not be null
  70.   (setq bp (getpoint "\nCenter point: "))
  71.   (initget 7)                         ; nt must not be zero, neg, or null
  72.   (setq nt (getint "\nNumber of rotations: "))
  73.   (initget 3)                         ; cf must not be zero, or null
  74.   (setq cf (getdist "\nGrowth per rotation: "))
  75.   (initget 6)                         ; lp must not be zero or neg
  76.   (setq lp (getint "\nPoints per rotation <30>: "))
  77.   (cond ((null lp) (setq lp 30))) 
  78.   (cspiral nt bp cf lp)
  79.   (setvar "cmdecho" ocmd)
  80.   (setvar "blipmode" oblp)
  81.   (setq *error* olderr)               ; Restore old *error* handler
  82.   (princ)
  83.  
  84. ) 
  85.  
  86. ;;; --------------------------------------------------------------------------;
  87.  
  88.  
  89.