home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / may94cad.zip / TIP986.LSP < prev    next >
Lisp/Scheme  |  1994-04-25  |  1KB  |  46 lines
  1. ; TIP986.LSP: STAR.LSP   Draw Stars   (c)1994, Robert Trombley
  2.  
  3. (defun C:STAR (/ A C CT D H L MX N NA P P1 R R2 S)
  4.  (setq A (/ pi 2.0) C nil CT 0 NA 0 R 0)
  5.  (while (not C)
  6.   (setq C (getpoint "\nCenter of star? "))
  7.   (if (not C) (princ "\nRequires point. "))
  8.  )
  9.  (while (or (not NA) (< NA 3))
  10.   (setq NA (getint "\nNumber of arms? "))
  11.   (if (or (not NA) (< NA 3)) (princ "\nMust be 3 or more. "))
  12.  )
  13.  (while (or (not R) (<= R 0))
  14.   (setq R (getdist C "\nRadius? "))
  15.   (if (or (not R) (<= R 0)) (princ "\nMust be positive. "))
  16.  )
  17.  (setq P1 (polar C A R)
  18.        N (* NA 2.0)
  19.        D (/ (* pi 2.0) N)
  20.        L (/ (* R (sin D)) (sin (+ A D)))
  21.        H (* L (sin (- A (+ D D))))
  22.  )
  23.  (if (or (= NA 3) (= NA 4)) (setq H (/ R 5.0)))
  24.  (princ "\nInner width for each arm? <")
  25.  (princ (+ H H))
  26.  (setq MX (getreal ">: "))
  27.  (if MX (setq H (/ MX 2.0)))
  28.  (setq R2 (/ H (sin D)))
  29.  (command "LINE" P1
  30.   (while (< CT N)
  31.    (if (= (/ CT 2.0) (fix (/ CT 2.0)))
  32.     (setq S R2)
  33.     (setq S R)
  34.    )
  35.    (setq P (polar C (+ A D) S)
  36.          D (+ D (/ (* pi 2.0) N))
  37.    )
  38.    (command (car (list P)))
  39.    (setq CT (1+ CT))
  40.    (if (= CT N) (command ""))
  41.   )
  42.  )
  43.  (princ)
  44. )
  45.  
  46.