home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 11.img / BONUS2.LIB / RPOLY.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  3.8 KB  |  125 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; RPOLY.LSP
  3. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  4. ;;;
  5. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  6. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  7. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  8. ;;;
  9. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  10. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  11. ;;;
  12. ;;;
  13. ;;;
  14. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  15. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  16. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  17. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  18. ;;;
  19. ;;;
  20. ;;;   Written by Kelvin R. Throop in October 1985
  21. ;;;
  22. ;;;   Based on the technique described in Philip J. Davis,
  23. ;;;   "Circulant Matrices", Wiley 1979.
  24. ;;;
  25. ;;; --------------------------------------------------------------------------;
  26. ;;; DESCRIPTION
  27. ;;;
  28. ;;;   Refinement of a random polygon by iterative replacement of
  29. ;;;   its vertices by the midpoints of its edges.  This miraculously
  30. ;;;   transforms most random polygons into an ellipse-shaped convex
  31. ;;;   polygon.
  32. ;;;
  33. ;;;   Added error checking and an error function - April 1988
  34. ;;;
  35. ;;;   Added version number, line rubberbanding and the ability to
  36. ;;;   retain each iteration of the polygon. Jeff Wilson 12June1990
  37. ;;;
  38. ;;; --------------------------------------------------------------------------;
  39. (defun drawpoly (p / dp dl)
  40.   (setq dp p)
  41.   (setq dl (length p))
  42.   (command "_.PLINE")
  43.   (repeat dl
  44.     (command (car dp))
  45.     (setq dp (cdr dp))
  46.   )
  47.   (command "_C")
  48. )
  49.  
  50. (defun myerror (s)                    ; If an error (such as CTRL-C) occurs
  51.                                       ; while this command is active...
  52.   (if (/= s "Function cancelled")
  53.     (princ (strcat "\n┐∙╗~: " s))
  54.   )
  55.   (setvar "cmdecho" ocmd)             ; Restore saved modes
  56.   (setvar "blipmode" oblp)
  57.   (setq *error* olderr)               ; Restore old *error* handler
  58.   (princ)
  59. )
  60.  
  61. (defun C:RPOLY (/ olderr ocmd oblp cycno pl p pvert cyc plast pn pe pc delpoly)
  62.   (princ "\n╜╒┼▄íuªh├Σº╬ív, ¬⌐Ñ╗ 1.1 Autodesk ñ╜ÑqíC")
  63.   (setq olderr  *error*
  64.         *error* myerror)
  65.   (setq ocmd (getvar "cmdecho"))
  66.   (setq oblp (getvar "blipmode"))
  67.   (setvar "cmdecho" 0)
  68.   (setq cycno 0)
  69.   (setq pl nil)
  70.   (command "_.UNDO" "_MARK")
  71.   (setq p1 (getpoint "\n▓─ñ@┬I: "))
  72.   (setq pl (cons p1 pl))
  73.   (while (setq p (getpoint p1 "\nñUñ@┬I: "))
  74.     (command "_.LINE" p1 p "")
  75.     (setq p1 p)
  76.     (setq pl (cons p pl))
  77.   )
  78.   (command "_.UNDO" "_BACK")
  79.   (setvar "blipmode" 0)
  80.   (setq pvert (length pl))
  81.   (if pl
  82.     (progn
  83.       (drawpoly pl)
  84.       (initget 6)
  85.       (while (setq cyc (getint "\n┤`└⌠ª╕╝╞: "))
  86.         (initget "Yes No")
  87.         (setq delpoly
  88.           (getkword "½O»d¿Cª╕┤`└⌠¬║íuªh├Σº╬ív? <Y>/N: ")
  89.         )
  90.         (princ "┤`└⌠:")
  91.         (repeat cyc
  92.           (setq plast (nth (1- pvert) pl))
  93.           (setq pn nil)
  94.           (setq pe pl)
  95.           (repeat pvert
  96.             (setq pc (car pe))
  97.             (setq pe (cdr pe))
  98.             (setq pn (cons (list (/ (+ (car pc) (car plast)) 2)
  99.                                  (/ (+ (cadr pc) (cadr plast)) 2))
  100.                            pn)
  101.             )
  102.             (setq plast pc)
  103.           )
  104.           (setq pl pn)
  105.           (setq cycno (1+ cycno))
  106.           (princ " ")
  107.           (princ cycno)
  108.           (if (cond
  109.                 ((= delpoly "No") t)
  110.                 (t nil)
  111.               )
  112.             (command "_.ERASE" "_L" "")
  113.           )
  114.           (drawpoly pn)
  115.         )
  116.         (initget 6)
  117.       )
  118.     )
  119.   )
  120.   (setvar "cmdecho" ocmd)
  121.   (setvar "blipmode" oblp)
  122.   (setq *error* olderr)               ; Restore old *error* handler
  123.   (princ)
  124. )
  125.