Topic: Challenge : Regular Polygon

[CAB]

Challenge:
Create a subroutine to Draw / Entmake a regular polygon.

Given:

• Center point
• No. of Sides >2
• Size - Radius Value
• Inscribe or Circumscribe Flag

[gile]

Here's my contribution :

Code: [Select]

;; Center point -> cen
;; No. of Sides >2 -> nb
;; Size - Radius Value -> rad
;; Inscribe or Circumscribe Flag -> flag

(defun draw_polygon (cen nb rad flag / zdir elv n lst)
  (setq zdir (trans '(0 0 1) 1 0 T)
elv  (- (caddr cen) (caddr (trans '(0 0 0) 0 1)))
cen  (list (car cen) (cadr cen) 0.0)
n    nb
  )
  (if (= flag "Circumscribe")
    (setq rad (/ rad (cos (/ pi nb))))
  )
  (repeat nb
    (setq lst (cons (polar cen (* (/ (* 2 pi) nb) (setq n (1- n))) rad) lst))
  )
  (entmake
    (append
      (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    (cons 90 nb)
    '(70 . 1)
    (cons 38 elv)
    (cons 210 zdir)
      )
      (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) lst)
    )
  )
)
EDIT: add a test function.

Code: [Select]

(defun c:test (/ cen nb rad flag)
  (setq cen (getpoint "\nCenter: ")
nb  (getint "\nNumber of sides: ")
rad (getdist cen "\Radius: ")
  )
  (initget 1 "Inscribe Circumscribe")
  (setq
    flag (getkword "\nInscribe or Circumscribe ? [Inscribe/Circumscribe]: ")
  )
  (draw_polygon cen nb rad flag)
  (princ)
)

[Fatty]

As always I/m late again

Code: [Select]

(defun _entmake_polygon_eX (pt no rad flag / a da cnt pt pts rad x y)
 
  (setq da  (/ (* 2 pi) no)
rad (if flag ;Inscribe
      rad
      (* rad (cos (/ pi no))));Circumscribe
cnt 0
a   0
  )
  (while (< cnt no)
    (setq a (* da cnt))
    (setq x (* rad (cos a))
  y (* rad (sin a))
    )
    (setq pts (cons (list x y) pts))
    (setq cnt (1+ cnt))
  )
  (setq pts (mapcar (function (lambda (x)
(mapcar '+ x pt)
      )
    )
    (reverse pts)
    )
  )
  (entmake
    (append
      (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 no)
(cons 70 1)
(cons 43 0.0)
      )
      (mapcar (function (lambda (x)
  (cons 10 x)
)
      )
      pts
      )
    )
  )
)
;TesT :
(_entmake_polygon_eX '(0 0) 9 42.545 nil)
(_entmake_polygon_eX '(0 0) 9 42.545 t)

~'J'~

[CAB]

Great job Guy's.

Gile your's works as expected.

Fatty your Inscribe is as expected but the circumscribe is not.
With circumscribe the apothem and radius entered should be the same.

[Fatty]

Great job Guy's.

Gile your's workes as expected.

Fatty your Inscribe is as expected but the circumscribe is not.
With circumscribe the apothem and radius entered should be the same.

Thank you, Alan,
here is edited version, I don't know why I have used multiple
instead of divide, sorry

Code: [Select]

(defun _entmake_polygon_eX (pt no rad flag / a da cnt pt pts rad x y)
 
  (setq da  (/ (* 2 pi) no)
rad (if flag
      (/ rad (cos (/ pi no))) ;Circumscribe
      rad ;Inscribe
      )
cnt 0
a   0
  )
  (while (< cnt no)
    (setq a (* da cnt))
    (setq x (* rad (cos a))
  y (* rad (sin a))
    )
    (setq pts (cons (list x y) pts))
    (setq cnt (1+ cnt))
  )
  (setq pts (mapcar (function (lambda (x)
(mapcar '+ x pt)
      )
    )
    (reverse pts)
    )
  )
  (entmake
    (append
      (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 no)
(cons 70 1)
(cons 43 0.0)
      )
      (mapcar (function (lambda (x)
  (cons 10 x)
)
      )
      pts
      )
    )
  )
)
;TesT :
(_entmake_polygon_eX '(0 0) 8 50.0 nil);Inscribe
(_entmake_polygon_eX '(0 0) 8 50.0 t);Circumscribe

here is another one, where I have to used the segment length as a size

Code: [Select]

(defun _entmake_polygonSeg (pt no segm / a da cnt pt pts rad x y)
 
  (setq da  (/ (* 2 pi) no)
rad (/ segm 2 (sin (/ pi no)))
cnt 0
a   0
  )
  (while (< cnt no)
    (setq a (* da cnt))
    (setq x (* rad (cos a))
  y (* rad (sin a))
    )
    (setq pts (cons (list x y) pts))
    (setq cnt (1+ cnt))
  )
  (setq pts (mapcar (function (lambda (x)
(mapcar '+ x pt)
      )
    )
    (reverse pts)
    )
  )
  (entmake
    (append
      (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 no)
(cons 70 1)
(cons 43 0.0)
      )
      (mapcar (function (lambda (x)
  (cons 10 x)
)
      )
      pts
      )
    )
  )
)
;TesT :
(_entmake_polygonSeg '(0 0) 8 50.0)

~'J'~

[CAB]

Good job Fatty & a nice extra routine.

[CAB]

OK, here is a level 2 challenge.
Create the polygon so that one side is parallel to the x axis.

[gile]

For the level 2 challenge:

Code: [Select]

(defun draw_polygon (cen nb rad flag / zdir elv n lst)
  (setq zdir (trans '(0 0 1) 1 0 T)
elv  (- (caddr cen) (caddr (trans '(0 0 0) 0 1)))
cen  (list (car cen) (cadr cen) 0.0)
n    nb
  )
  (if (= flag "Circumscribe")
    (setq rad (/ rad (cos (/ pi nb))))
  )
  (if (= 1 (rem nb 2))
    (setq ang (/ pi 2))
    (setq ang (+ (/ pi 2) (/ pi nb)))
)
  (repeat nb
    (setq lst (cons (polar cen (+ ang (* (/ (* 2 pi) nb) (setq n (1- n)))) rad) lst))
  )
  (entmake
    (append
      (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    (cons 90 nb)
    '(70 . 1)
    (cons 38 elv)
    (cons 210 zdir)
      )
      (mapcar '(lambda (pt) (cons 10 (trans pt 1 zdir))) lst)
    )
  )
)

(defun c:test (/ cen nb rad flag)
  (setq cen (getpoint "\nCenter: ")
nb  (getint "\nNumber of sides: ")
rad (getdist cen "\Radius: ")
  )
  (initget 1 "Inscribe Circumscribe")
  (setq
    flag (getkword "\nInscribe or Circumscribe ? [Inscribe/Circumscribe]: ")
  )
  (draw_polygon cen nb rad flag)
  (princ)
)

[Fatty]

First side and X axis are parallel:

Code: [Select]

(defun _entmake_polygon_XAxis (pt no rad flag / a da cnt pt pts rad x y)
 
  (setq da  (/ (* 2 pi) no)
rad (if flag
      (/ rad (cos (/ pi no))) ;Circumscribe
      rad ;Inscribe
      )
cnt 0
sa   (- (* 1.5 pi)(/ pi no))
a 0
  )
  (while (< cnt no)
    (setq a (+ sa (* da cnt)))
    (setq x (* rad (cos a))
  y (* rad (sin a))
    )
    (setq pts (cons (list x y) pts))
    (setq cnt (1+ cnt))
  )
  (setq pts (mapcar (function (lambda (x)
(mapcar '+ x pt)
      )
    )
    (reverse pts)
    )
  )
  (entmake
    (append
      (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 no)
(cons 70 1)
(cons 43 0.0)
      )
      (mapcar (function (lambda (x)
  (cons 10 x)
)
      )
      pts
      )
    )
  )
)
;TesT :
(_entmake_polygon_XAxis '(0 0) 9 50.0 nil);Inscribe
(_entmake_polygon_XAxis '(0 0) 9 50.0 t);Circumscribe

First side and Y axis are parallel:

Code: [Select]

(defun _entmake_polygon_YAxis (pt no rad flag / a da cnt pt pts rad x y)
 
  (setq da  (/ (* 2 pi) no)
rad (if flag
      (/ rad (cos (/ pi no))) ;Circumscribe
      rad ;Inscribe
      )
cnt 0
sa   (- pi (/ pi no))
a 0
  )
  (while (< cnt no)
    (setq a (+ sa (* da cnt)))
    (setq x (* rad (cos a))
  y (* rad (sin a))
    )
    (setq pts (cons (list x y) pts))
    (setq cnt (1+ cnt))
  )
  (setq pts (mapcar (function (lambda (x)
(mapcar '+ x pt)
      )
    )
    (reverse pts)
    )
  )
  (entmake
    (append
      (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 no)
(cons 70 1)
(cons 43 0.0)
      )
      (mapcar (function (lambda (x)
  (cons 10 x)
)
      )
      pts
      )
    )
  )
)
;TesT :
(_entmake_polygon_YAxis '(0 0) 7 50.0 nil);Inscribe
(_entmake_polygon_YAxis '(0 0) 7 50.0 t);Circumscribe

~'J'~

[CAB]

Excellent solutions. You guy's are too fast.

[sinc]

Excellent solutions. You guy's are too fast.

...and nobody's using (command "_polygon")... 

[CAB]

Here is my revised version.
I must say I benefited form the fine examples already posted.
My first attempts were clumsy by comparison.

Code: [Select]

(defun mk_polygon (pt n rad ci? / ang ang1 lst)
  (and ci? (setq rad (/ rad (cos (/ pi n)))))
  (setq ang  (/ pi (/ n 2.))
        ang1 (+ (* pi 1.5) (/ ang 2))
  )

  (while (>= (setq n (1- n)) 0)
    (setq lst (cons (cons 10 (polar pt (+ ang1 (* ang n)) rad)) lst))
  )

  (entmake
    (append (list (cons 0 "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                  (cons 70 1)
                  (cons 43 0.0)
                  (cons 38 0.0)
                  (cons 39 0.0)
            )
            lst
    )
  )
)

Code: [Select]

(defun c:test (/ cen nb rad flag)
  (setq cen (getpoint "\nCenter: ")
        nb  (getint "\nNumber of sides: ")
        rad (getdist cen "\Radius: ")
  )
  (initget "Inscribe Circumscribe")
  (setq flag
         (cond
           ((getkword "\nType ? [Inscribe/Circumscribe]: <Inscribe>"))
           ("Inscribe")))

  (mk_polygon cen nb rad (= flag "Circumscribe"))

  (princ)
)

[CAB]

Gile,
You seem to have a very good understanding of the coordinate system & the use of trans.
It would be beneficial to me and a number of folks here if you would share that knowledge in a
separate post of even an article on the subject.
Especially,  "when you need it" and what commands & function need what type of trans.

I know that is a lot to ask as that type of post is very time consuming on your part, so if
it not something you have time for I'll / we will keep learning from the code you post.

Thanks for your examples.

[CAB]

Gile,
Just to clarify, I am talking about an "Over View" of the application of trans. 

[CAB]

This version provide the ability to align a specific side with the x or y axis.

Code: [Select]

;;  CAB version2  11/15/2006
;;  Arguments:
;;  pt    center point
;;  n     number of sides
;;  rad   radius of circle
;;  ci?   t/nil Cercumscribe/Inscribe on the circle
;;  align string, side with xTop or xBottom or yRight or yLeft
;;  lay   string, layer name
;;  clr   color number
(defun mk_polygon (pt n rad ci? align lay clr / ang ang1 lst)
  (setq ang  (/ pi (/ n 2.0))
        align (strcase align))
  (cond
    ((= align "XBOTTOM")
     (setq ang1 (+ (* pi 1.5) (/ ang 2)))
    )
    ((= align "XTOP")
     (setq ang1 (+ (* pi 1.5) (/ ang 2) pi))
    )
    ((= align "YRIGHT")
     (setq ang1 (+ (/ ang 2)))
    )
    ((= align "YLEFT")
     (setq ang1 (+ (/ ang 2) pi))
    )
    (t (setq ang1 0))
  )
  (and ci? (setq rad (/ rad (cos (/ pi n)))))

  (while (>= (setq n (1- n)) 0)
    (setq lst (cons (cons 10 (polar pt (+ ang1 (* ang n)) rad)) lst))
  )
  (entmake
        (append (list (cons 0 "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      (cons 8 lay)
                      (cons 90 (length lst))
                      (cons 70 1) ; 0= open  1= closed
                      (cons 43 0.0)
                      (cons 38 0.0)
                      (cons 39 0.0)
                      (cons 62 clr) ; color bylayer
                )
                lst
        )
  )
)

Code: [Select]

(defun c:test2(/ wait ss)
  (defun wait (prm) (getstring (if prm prm "\nPress enter to continue")))
  (setq ss (ssadd))
  (mk_polygon '(0.0 0.0 0.0) 5 5 t "xTop" "0" 1)
  (ssadd (entlast) ss)
  (wait "\nxTop")
  (mk_polygon '(0.0 0.0 0.0) 5 5 t "xBottom" "0" 2)
  (ssadd (entlast) ss)
  (wait "\nxBottom")
  (mk_polygon '(0.0 0.0 0.0) 5 5 nIL "yRight" "0" 3)
  (ssadd (entlast) ss)
  (wait  "\nyRight")
  (mk_polygon '(0.0 0.0 0.0) 5 5 nil "yLeft" "0" 4)
  (ssadd (entlast) ss)
  (wait  "\nyLeft")
  (mk_polygon '(0.0 0.0 0.0) 5 5 nil "xy45R" "0" 5)
  (ssadd (entlast) ss)
  (wait  "\nxy45R")
  (mk_polygon '(0.0 0.0 0.0) 5 5 nil "xy45L" "0" 6)
  (ssadd (entlast) ss)
  (wait  "\nxy45L")
  (command "._erase" ss "")
  (princ)
)