;;; --------------------------------------------------------------------------;
;;;   SPIRAL_F.LSP
;;; 
;;;  (Urprung SPIRAL.LSP)
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;  
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted.  
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; --------------------------------------------------------------------------;
;;; DESCRIPTION
;;;
;;;   This is a programming example.
;;;
;;;   Designed and implemented by Kelvin R. Throop in January 1985
;;;
;;;   This program constructs a spiral. It can be loaded and called 
;;;   by typing either "spiral", "3dspiral" or the following:
;;;   (cspiral <# rotations> <base point> <horiz growth per rotation>
;;;            <points per circle> <start radius> 
;;;            <vert growth per rotation>).
;;;
;;; --------------------------------------------------------------------------;
;;;
;;; mit Änderungen/Ergänzungen von flaschenpost (cad.de),13.03.2005
;;; 
;;; --------------------------------------------------------------------------;

(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setvar "cmdecho" ocmd)             ; Restore saved modes
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)


(defun cspiral (ntimes bpoint hfac lppass strad vfac 
                / ang dist tp ainc dhinc dvinc circle dv n) 
  (setvar "blipmode" 0)               ; turn blipmode off
  (setvar "cmdecho" 0)                ; turn cmdecho off
  (setq circle (* 3.141596235 2))
  (setq ainc (/ circle lppass))
  (setq dhinc (/ hfac lppass))
  (if vfac (setq dvinc (/ vfac lppass)))
  (setq ang (- 0.0 ainc))
  
  (if vfac
    (setq dist strad dv 0.0)
    (setq dist 0.0)
  )
  (setq n 0)
  (if (/= vfac 0)
     (progn (if (minusp hfac)(command "_.3dpoly")(command "_.3dpoly" bpoint)))               (progn (if (minusp hfac)(command "_pline")(command "_pline" bpoint)))
  )
  (repeat ntimes 
      (setq n (1+ n))  
      (repeat (if (= n ntimes)(1+ lppass) lppass) 
      (setq tp (polar bpoint (setq ang (+ ang ainc)) dist))
      (setq dist (+ dist dhinc))
      (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp))))
      (setq dv (+ dv dvinc))
      (command tp)                    ; continue to the next point...
    )
  ) 
  (if (minusp hfac)
     (progn
     (command (list(car bpoint)(cadr bpoint)(+ dv (caddr bpoint))) )
     (command "")
     )
     (command "")
  ); until done
  (princ)
) 

;;;
;;;       Interactive spiral generation
;;;

(defun C:SPIRAL (/ oldmode olderr ocmd oblp nt bp cf lp) 
  ;;;;(setq olderr  *error*
  ;;;;      *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                         ; bp must not be null
  (setq bp (getpoint "\nMittelpunkt: "))
  (initget 5)                         ; sr must not be zero, neg, or null
  (setq sr (getdist bp "\nAnfangsradius eingeben oder zeigen: "))
  (initget 5)                         ; cf must not be zero, or null
  (while (= (setq cf (getdist bp "\nEndradius eingeben oder zeigen: ")) sr)
         (prompt "\nAnfangs- und Endradius dürfen nicht gleich sein !")
  )
  (initget 7)                         ; nt must not be zero, neg, or null
  (setq nt (getint "\nAnzahl Windungen: "))
  (setq cf (/ (- cf sr) nt))  
  (initget 6)                         ; lp must not be zero or neg
  (setq lp (getint "\nPunkte pro Windung <30>: "))
  (cond ((null lp) (setq lp 30))) 
  (setq oldmode (getvar "osmode"))
  (setvar "osmode" 0)
  (cspiral nt bp cf lp sr 0)
  (setvar "osmode" oldmode)
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
) 

;;;
;;;       Interactive spiral generation
;;;

(defun C:3DSPIRAL (/ oldmode olderr ocmd oblp nt bp hg vg sr lp) 
  ;;;;(setq olderr  *error*
  ;;;;      *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                         ; bp must not be null
  (setq bp (getpoint "\nMittelpunkt: "))
  (initget 5)                         ; sr must not be zero, neg, or null
  (setq sr (getdist bp "\nAnfangsradius eingeben oder zeigen: "))
  (initget 5)                         ; cf must not be zero, or null
  (while (and 
         (= (setq hg (getdist bp "\nEndradius eingeben oder zeigen: ")) sr)
         (= sr 0)
         );and
         (prompt "\nEndradius darf nicht 0 sein, wenn Anfangsradius 0 ist !")
  )
  (initget 3)                         ; cf must not be zero, or null
  (setq vg (getdist "\nHöhe der Spirale (positiv, negativ, ungleich 0): "))
  (initget 7)                         ; nt must not be zero, neg, or null
  (setq nt (getint "\nAnzahl Windungen: "))
  (setq hg (/ (- hg sr) nt))   
  (setq vg (/ vg nt))
  (initget 6)                         ; lp must not be zero or neg
  (setq lp (getint "\nPunkte pro Windung <30>: "))
  (cond ((null lp) (setq lp 30))) 
  (setq oldmode (getvar "osmode"))
  (setvar "osmode" 0)
  (cspiral nt bp hg lp sr vg)
  (setvar "osmode" oldmode)
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
) 

;;; --------------------------------------------------------------------------;
(prompt "\nSPIRAL.LSP erfolgreich geladen ! ")
(prompt "\nAufruf mit SPIRAL (Polylinie) oder 3DSPIRAL (3D-Polylinie)")
(princ)