77 lines
2.8 KiB
Common Lisp
77 lines
2.8 KiB
Common Lisp
;;; --------------------------------------------------------------------------;
|
|
;;; SPIRAL.LSP
|
|
;;; Copyright (C) 1990 by Autodesk, Inc.
|
|
;;; --------------------------------------------------------------------------;
|
|
;;; BESCHREIBUNG
|
|
;;;
|
|
;;; Dies ist ein Programmierbeispiel.
|
|
;;;
|
|
;;; Entwickelt von Kelvin R. Throop im Januar 1985
|
|
;;;
|
|
;;; Das Programm zeichnet eine Spirale. Man kann es entweder
|
|
;;; mit dem Befehl: "SPIRAL" starten und die Parameter im Dialog
|
|
;;; eingeben oder als Lispaufruf die Werte als Argumente �bergeben:
|
|
;;; (cspiral <Anzahl Umdrehungen> <Basispunkt> <Zuwachs pro Umdrehung>
|
|
;;; <Punkte pro Umdrehung>).
|
|
;;; --------------------------------------------------------------------------;
|
|
|
|
(defun myerror (s) ; F�r Fehler (z.B. CTRL-C) w„hrend
|
|
; dieser Befehl aktiv ist...
|
|
(if (/= s "Funktion abgebrochen")
|
|
(princ (strcat "\nFehler: " s))
|
|
)
|
|
(setvar "cmdecho" ocmd) ; gesicherte Modi wiederherstellen
|
|
(setvar "blipmode" oblp)
|
|
(setq *error* olderr) ; wiederherstellen des alten *error* handlers
|
|
(princ)
|
|
)
|
|
|
|
|
|
(defun cspiral (ntimes bpoint cfac lppass / ang dist tp ainc dinc circle)
|
|
(setvar "blipmode" 0) ; blipmode ausschalten
|
|
(setvar "cmdecho" 0) ; cmdecho ausschalten
|
|
(setq circle (* 3.141596235 2))
|
|
(setq ainc (/ circle lppass))
|
|
(setq dinc (/ cfac lppass))
|
|
(setq ang 0.0)
|
|
(setq dist 0.0)
|
|
(command "plinie" bpoint) ; Spirale vom Basispunkt starten und ...
|
|
(repeat ntimes
|
|
(repeat lppass
|
|
(setq tp (polar bpoint (setq ang (+ ang ainc))
|
|
(setq dist (+ dist dinc))
|
|
))
|
|
(command tp) ; mit n„chsten Punkt fortsetzen ...
|
|
)
|
|
)
|
|
(command "") ; bis zum Schluss.
|
|
(princ)
|
|
)
|
|
|
|
;;;
|
|
;;; Interaktive Erzeugung der Spirale
|
|
;;;
|
|
|
|
(defun C:SPIRAL (/ 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 darf nicht Null sein
|
|
(setq bp (getpoint "\nMittelpunkt: "))
|
|
(initget 7) ; nt darf nicht 0, negativ oder Null sein
|
|
(setq nt (getint "\nAnzahl der Umdrehungen: "))
|
|
(initget 3) ; cf darf nicht 0 oder Null sein
|
|
(setq cf (getdist "\nZuwachs pro Umdrehung: "))
|
|
(initget 6) ; lp darf nicht 0 oder negativ sein
|
|
(setq lp (getint "\nPunkte pro Umdrehung <30>: "))
|
|
(cond ((null lp) (setq lp 30)))
|
|
(cspiral nt bp cf lp)
|
|
(setvar "cmdecho" ocmd)
|
|
(setvar "blipmode" oblp)
|
|
(setq *error* olderr) ; Wiederherstellen des alten *error* handlers
|
|
(princ)
|
|
)
|
|
;;; --------------------------------------------------------------------------;
|
|
|