;;; --------------------------------------------------------------------------;
;;; RPOLY.LSP
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;
;;;   Entwickelt von Kelvin R. Throop im Oktober 1985
;;;
;;;   Basierend auf der technischen Beschreibung von 
;;;   Philip J. Davis , "Circulant Matrices", Wiley 1979.
;;;
;;; --------------------------------------------------------------------------;
;;;   BESCHREIBUNG
;;;
;;;   Verfeinerung von beliebigen Polygonen durch zyklisches
;;;   Ersetzen der Scheitelpunkte durch die Kantenmittelpunkte.
;;;   Wie durch ein Wunder werden dann die meisten Polygone fr�her
;;;   oder sp„ter zu elliptisch konvexen Gebilden.
;;;
;;;   Fehler�berpr�fung und Fehlerbehandlungsroutine
;;;   hinzugef�gt - April 1988

;;;   Versionsnummer, Gummibandlinie, und die F„higkeit jeden Verfeinerungs-
;;;   zyklus der Polylinie festzuhalten.          Jeff Wilson 12. Juni 1990
;;;
;;; --------------------------------------------------------------------------;

(defun drawpoly (p / dp dl)
  (setq dp p)
  (setq dl (length p))
  (command "plinie")
  (repeat dl
    (command (car dp))
    (setq dp (cdr dp))
  )
  (command "s")
)

(defun myerror (s)                    ; Wenn ein Fehler (z.B. CTRL-C)
                                      ; w„hrend dieses Befehls auftritt
  (if (/= s "Funktion abgebrochen")
    (princ (strcat "\nFehler: " s))
  )
  (setvar "cmdecho" ocmd)             ; "cmdecho" wiederherstellen
  (setvar "blipmode" oblp)            ; "blipmode" wiederherstellen
  (setq *error* olderr)               ; Fehlerroutine wiederherstellen
  (princ)
)

(defun C:RPOLY (/ olderr ocmd oblp cycno pl p pvert cyc plast pn pe pc delpoly)
  (princ "\nPolygonverfeinerung, Version 1.1 von Autodesk,Inc.")
  (setq olderr  *error*
        *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (setq cycno 0)
  (setq pl nil)
  (command "zur�ck" "mark")
  (setq p1 (getpoint "\nErster Punkt: "))
  (setq pl (cons p1 pl))
  (while (setq p (getpoint p1 "\nN„chster Punkt: "))
    (command "linie" p1 p "")
    (setq p1 p)
    (setq pl (cons p pl))
  )
  (command "zur�ck" "r�ck")
  (setvar "blipmode" 0)
  (setq pvert (length pl))
  (if pl 
    (progn
      (drawpoly pl)
      (initget 6)
      (while (setq cyc (getint "\nAnzahl Zyklen: "))
        (initget "Ja Nein")
        (setq delpoly 
          (getkword "Polygonform nach jedem Zyklus festhalten ? <J>/N: ")
        )
        (princ "Zyklen:")
        (repeat cyc
          (setq plast (nth (1- pvert) pl))
          (setq pn nil)
          (setq pe pl)
          (repeat pvert
            (setq pc (car pe))
            (setq pe (cdr pe))
            (setq pn (cons (list (/ (+ (car pc) (car plast)) 2)
                                 (/ (+ (cadr pc) (cadr plast)) 2))
                           pn)
            )
            (setq plast pc)
          )
          (setq pl pn)
          (setq cycno (1+ cycno))
          (princ " ")
          (princ cycno)
          (if (cond 
                ((= delpoly "Nein") t)
                (t nil)
              )
            (command "l”schen" "l" "")
          )
          (drawpoly pn)
        )
        (initget 6)
      )
    )
  )
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Fehlerbehandlungsroutine wiederherstellen
  (princ)
)