Étoiles et polygones croisés

[(gile)]

Un petit LISP pour dessiner des étoiles avec le nombre de branches qu'on veut (supérieur à 4, bien sûr).

 

 

;;; Etoiles (gile) 05/01/07 
;;; Pour dessiner des étoiles avec nombre de branches spécifié.

(defun c:etoiles (/ br cen som ang dist int n zdir lst1 lst2)
 (initget 7)
 (setq br (getint "\nSpécifiez le nombre de branches: "))
 (if (    (progn
     (initget 1)
     (setq cen	(getpoint "\nSpécifiez le centre de l'étoile: ")
    som	cen
     )
     (while (equal cen som)
(initget 1)
(setq
  som (getpoint	cen
		"\nSpécifiez le sommet d'une des branches: "
      )
)
     )
     (setq ang	 (angle cen som)
    dist (distance cen som)
    int	 (fix (/ (- br 0.5) 2))
    n	 (* 2 br)
    zdir (trans '(0 0 1) 1 0 T)
     )
     (repeat br
(setq
  lst1
   (cons
     (polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)
     lst1
   )
)
     )
     (repeat br
(setq lst2
       (cons (inters (nth n lst1)
		     (nth (rem (+ n br (- int)) br) lst1)
		     (nth (rem (+ n (1- int)) br) lst1)
		     (nth (setq n (rem (+ n (1- br)) br)) lst1)
	     )
	     lst2
       )
)
     )
     (entmake
(append
  (list	'(0 . "LWPOLYLINE")
	'(100 . "AcDbEntity")
	'(100 . "AcDbPolyline")
	(cons 90 (* 2 br))
	'(70 . 1)
	(cons 38 (caddr (trans cen 1 zdir)))
	(cons 210 zdir)
  )
  (mapcar
    '(lambda (pt)
       (cons 10 (trans pt 1 zdir))
     )
    (apply 'append
	   (apply 'mapcar (cons 'list (list lst1 lst2)))
    )
  )
)
     )
   )
   (prompt "\nLe nombre de branches doit être supérieur à 4.")
 )
 (princ)
) 

[Edité le 6/1/2007 par (gile)]

 

[Edité le 7/1/2007 par (gile)]

[(gile)]

Dans le même esprit, un autre pour dessiner des polygones réguliers croisés (polygones "étoilés").

 

Pour le même nombre de sommets, il peut exister plusieurs polygones "étoilés". Dans ce cas, il est demandé à l'utilisateur de spécifier un "indice de croisement".

 

Exemple pour un polygone à 7 sommets :

http://img359.imageshack.us/img359/9282/pgc1bg6.png

 

Nota : le nombre de branche et l'indice de croisement ne peuvent avoir de diviseur commun, d'où : aucune solution pour 6 sommets (l'étoile à 6 branche est constituée de 2 triangles équilatéraux), une seule pour 8 et pour 12 etc...

 

 

 

;;; PGC (gile) 07/01/07
;;; Crée une polyligne fermée figurant un polygone régulier croisé.
;;; Entrées utilisateur:
;;; - le nombre de sommets
;;; - l'indice de croisement, s'il existe plusieurs possibilités
;;; - le centre du polygone
;;; - un des sommets

(defun c:pgc (/ br imax n ind ilst cen som ang dist zdir lst1 plst)
 (initget 7)
 (setq	br   (getint "\nSpécifiez le nombre de sommets: ")
imax (fix (/ (- br 0.5) 2))
n    imax
 )
 (while (    (if	(= 1 (gcd br n))
     (setq ilst (cons (itoa n) ilst))
   )
   (setq n (1- n))
 )
 (if ilst
   (progn
     (if (	(progn
  (initget
    1
    (apply 'strcat
	   (cons (car ilst)
		 (mapcar '(lambda (x) (strcat " " x)) (cdr ilst))
	   )
    )
  )
  (setq
    ind
     (atoi
       (getkword
	 (strcat
	   "\nSpécifiez l'indice de croisement ["
	   (apply
	     'strcat
	     (cons
	       (car ilst)
	       (mapcar '(lambda (x) (strcat "/" x)) (cdr ilst))
	     )
	   )
	   "]: "
	 )
       )
     )
  )
)
(setq ind (atoi (car ilst)))
     )
     (initget 1)
     (setq cen	(getpoint "\nSpécifiez le centre du polygone: ")
    som	cen
     )
     (while (equal cen som)
(initget 1)
(setq
  som (getpoint	cen
		"\nSpécifiez un des sommets: "
      )
)
     )
     (setq ang	 (angle cen som)
    dist (distance cen som)
    n	 (* 2 br)
    zdir (trans '(0 0 1) 1 0 T)
     )
     (repeat br
(setq
  lst1
   (cons
     (polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)
     lst1
   )
)
     )
     (repeat br
(setq plst (cons (nth (rem (+ n ind) br) lst1) plst)
      n	   (+ n ind)
)
     )
     (entmake
(append
  (list	'(0 . "LWPOLYLINE")
	'(100 . "AcDbEntity")
	'(100 . "AcDbPolyline")
	(cons 90 br)
	'(70 . 1)
	(cons 38 (caddr (trans cen 1 zdir)))
	(cons 210 zdir)
  )
  (mapcar
    '(lambda (pt)
       (cons 10 (trans pt 1 zdir))
     )
    plst
  )
)
     )
   )
   (prompt
     (strcat "\nIl n'existe pas de polygone régulier croisé à "
      (itoa br)
      " côtés."
     )
   )
 )
 (princ)
) 

[(gile)]

Un dernier, juste pour s'amuser.

 

Charger le LISP dans un dessin vierge, taper CONSTEL et cliquer en différents points de la fenêtre (Enter ,Espace, clic droit ou Echap pour quitter le programme).

 

(defun c:constel (/ cen br ind ang dist n zdir lst1 lst2)
(defun rng (/ modulus multiplier increment random)
 (if (not seed)
   (setq seed (getvar "DATE"))
 )
 (setq modulus 4294967296.0
multiplier 1664525
increment 1
seed (rem (+ (* multiplier seed) increment) modulus)
random (/ seed modulus)
 )
)
 (command "_zoom" "_w" '(0 0) '(1600 1200))
 (while (setq cen (getpoint "\nSpécifiez un point: "))
   (setq br   (fix (+ (rem (* 100 (rng)) 8) 5))
  ind  (fix (/ (- br 0.5) 2))
  ang  (* (rng) pi)
  dist (+ 10 (* (rng) 100))
  n    (* 2 br)
  zdir (trans '(0 0 1) 1 0 T)
  lst1 nil
  lst2 nil
   )
   (repeat br
     (setq
lst1
 (cons
   (polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)
   lst1
 )
     )
   )
   (repeat br
     (setq lst2
     (cons (inters (nth n lst1)
		   (nth (rem (+ n br (- ind)) br) lst1)
		   (nth (rem (+ n (1- ind)) br) lst1)
		   (nth (setq n (rem (+ n (1- br)) br)) lst1)
	   )
	   lst2
     )
     )
   )
   (entmake
     (append
(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
	(cons 62 (fix (+ (rem (* 100 (rng)) 6) 1)))
      '(100 . "AcDbPolyline")
      (cons 90 (* 2 br))
      '(70 . 1)
      (cons 38 (caddr (trans cen 1 zdir)))
      (cons 210 zdir)
)
(mapcar
  '(lambda (pt)
     (cons 10 (trans pt 1 zdir))
   )
  (apply 'append
	 (apply 'mapcar (cons 'list (list lst1 lst2)))
  )
)
     )
   )
 )
 (princ)
) 

[LUDWIG]

magnifique !

 

le challenge va être de le placer dans mes dessin maintenant... Chiche ?

[yusukens82]

Travailler en s'amusant

quoi demandé de plus.

 

bravo gile