viernes, 19 de abril de 2013

Rutina STAR (dibuja una estrella)


;  Star -- Draw a Star
(defun C:STAR ()
  (initget 1)          ;prevent null input
  (setq Center (getpoint "Center of Star: "))        ;get center of star
  (initget (+ 1 2 4))  ;prevent null, zero, negative input
  (setq OutRad (getdist "Outside Radius: " Center))  ;get outside radius
  (initget (+ 1 2 4))  ;prevent null, zero, negative input
  (setq InRad  (getdist "Inside Radius: " Center))  ;get insider radius
  (initget (+ 1 2 4))  ;prevent null, zero, negative input
  (setq Points (getint "Number of Points: "))         ;:get number of points
  (while (< Points 2)  ;if not enough points (while Points < 2) ....
    (prompt "Must have at least 2 points!\n")
    (initget (+ 1 2 4))  ;prevent null, zero, negative input
    (setq Points (getint "Number of Points: "))      ;get number of points
  )
  (setq Incr (/ (* 2 pi) Points))   ;angular increment
  (setq Incr2 (/ Incr 2))          ;half of increment             
  (command "PLINE")        ;start polyline
  (setq Count 0)           ;set counter
  (while (< Count Points)  ;loop for points (until Count = Points)....
    (command (polar Center (* Count Incr) OutRad))  ;pick outside point
    (if (= Count 0)         ;if first segmnt
      (command "width" "0" "0"))    ;set line width to zero
    (command (polar Center (+ (* Count Incr) Incr2) InRad))   ;pick inside
    (setq Count (1+ Count))       ;increment counter
  )
  (command "Close")  ;close polyline
  (princ)            ;prevent echo
)
; Load Message
(princ "\nStar by Carl Guerin !!/11/92")
(princ "\nDraw a star (center, outside, inside, points).  Type STAR to use")
(princ)    

No hay comentarios:

Publicar un comentario