 ; Epi - epicycle generator.
 ; Copyright 1992, 1997 by Rocket Software Ltd.
 ; "To pure mathematics, and may it never do anyone any damn good."
 ; Consider this the implementation.
 (defun c:epi (/ pax pay fn constr rotcen coll lena gcomdn estrev prodab
                                              smlfac num no nnum xx yy pbb)
  (setvar "cmdecho" 0)
  (setq outer (if (= outer "T") "T" ()))
  (initget "Outer Inner")
  (setq fn (getkword (strcat "\nInner or Outer epicycle <"
                             (if outer "Outer" "Inner") ">: ")))
  (setq outer (cond ((= fn "Outer") "T")
                    ((= fn "Inner") ())
                    (T (if outer "T" ()))))
 ;-----------------------draw construction lines?-----------------------
  (setq constr (getstring "Draw construction lines? <N>: "))
  (if (and (/= constr "") (/= constr "N") (/= constr "n"))
      (progn
           (setq constr T)
           (setq coll (getvar "cecolor"))
           (command "color" "8"))
      (setq constr ()))
  (if (and pa (= (type pa) 'LIST))
      (progn
           (setq fn (getpoint pa "Centre point (<Return> for previous): "))
           (if fn (setq pa fn)))
           (setq pa (getpoint "Centre point: ")))
  (setq pax (car pa))
  (setq pay (cadr pa))
  (if (or (null aarad) (/= (type aarad) 'INT)) (setq aarad 45))
  (setq fn (getdist pa (strcat "\nBase circle radius <" (itoa aarad) ">: ")))
  (if fn (setq aarad (fix fn)))
  (if (= aarad 0) (setq aarad 1))
  (if constr (command "circle" pa aarad))
  (if (or (null bbrad) (/= (type bbrad) 'INT)) (setq bbrad 12))
  (setq fn (getdist pa (strcat "\nRotary circle radius <" (itoa bbrad) ">: ")))
  (if fn (setq bbrad (fix fn)))
  (if (= bbrad 0) (setq bbrad 1))
  (if constr
      (progn
           (if outer
              (progn
                   (setq rotcen (polar pa (/ pi 2) (+ aarad bbrad)))
                   (command "circle" (polar pa (/ pi 2) (+ aarad bbrad))
                                                                    bbrad)
                   (command "circle" pa (+ aarad bbrad)))
              (progn
                   (setq rotcen (polar pa (/ pi 2) (- aarad bbrad)))
                   (command "circle" (polar pa (/ pi 2) (- aarad bbrad))
                                                                   bbrad)
                   (command "line" (polar pa (/ pi 2) aarad)
                                   (polar pa (/ (* 3 pi) 2) aarad) "")
                   (command "line" (polar pa 0 aarad)
                                   (polar pa pi aarad) "")))))
 ;----------------reset colour if construction lines drawn----------------
  (if constr
     (progn
          (cond ((= coll "BYLAYER") (setq coll "BYLAYER"))
                ((= coll "BYBLOCK") (setq coll "BYBLOCK"))
                (t (setq coll (read coll))))
          (command "color" coll)))
 ;-------------find number of revolutions for complete figure-------------
  (setq gcomdn (gcd aarad bbrad))
  (if (= gcomdn 1)
      (setq estrev bbrad)
      (progn
           (setq prodab (* aarad bbrad))
           (setq smlfac (/ prodab gcomdn))
           (setq estrev (/ smlfac aarad))))
 ;------------------------------------------------------------------------
  (setq num (* estrev 72))
  (write-line (strcat "\nRevolutions to completion: " (itoa estrev)))
  (setq fn (getint (strcat "Number of revolutions <" (itoa estrev) ">: ")))
  (if fn (progn (setq estrev fn) (setq num (* fn 72))))
  (setq nnum (strcat "/" (itoa num) " segments"))
  (if (null rotcen) (setq rotcen pa))
  (setq hval bbrad)
  (setq fn (getdist rotcen (strcat "Eccentricity <" (rtos hval) ">: ")))
  (if fn (setq hval fn))
  (setq incr (/ (* 2 pi) 72))
  (setq no 1)
  (if outer
      (setq abab (+ aarad bbrad))
      (setq abab (- aarad bbrad)))           ; prelim. calc. outside loop
  (if paa 
      (progn
           (setq cont (getstring "\nContinue from last point? <N>: "))
           (if (and (/= cont "") (/= cont "N") (/= cont "n"))
               (setq cont T)
               (setq cont ()))))
  (if (or (null cont) (null paa))
      (progn
           (setq theta 0)
           (if outer
               (setq xx (- (* (cos theta) abab)
                           (* hval (cos (* abab (/ theta bbrad))))))
               (setq xx (+ (* (cos theta) abab)
                           (* hval (cos (* abab (/ theta bbrad)))))))
           (setq yy (- (* (sin theta) abab)
                       (* hval (sin (* abab (/ theta bbrad))))))
           (setq paa (list (+ pax xx) (+ pay yy)))))
  (command "pline" paa)
  (repeat num
          (setq theta (+ theta incr))
          (if outer
              (setq xx (- (* (cos theta) abab)
                          (* hval (cos (* abab (/ theta bbrad))))))
              (setq xx (+ (* (cos theta) abab)
                          (* hval (cos (* abab (/ theta bbrad)))))))
          (setq yy (- (* (sin theta) abab)
                      (* hval (sin (* abab (/ theta bbrad))))))
          (setq pbb (list (+ pax xx) (+ pay yy)))
          (command pbb)
          (setq paa pbb)
          (grtext -2 (strcat (itoa no) nnum))
          (setq no (1+ no)))
  (command "")
 (princ))