Polyèdres réguliers

Voir le sujet précédent Voir le sujet suivant Aller en bas

Polyèdres réguliers

Message  P.Fradin le Sam 19 Jan - 21:51

Voici une macro due à Alphonse Capriani, capable de dessiner les cinq polyèdres réguliers. Appelons cette macro PolyRegul, elle prend en entrée deux paramètres qui sont:

1) Le rayon de la sphère circonscrite au polyèdre,

2) le type de polyèdre, qui peut être donné soit sous forme d'une chaine de caractères: "tetra", "cube", "octa", icosa", "dodeca", ou bien sous forme d'un nombre à deux chiffres représentant le nombre de faces par sommet et le nombre de sommets par face (r et s), donc 33 pour le tétraèdre, 34 pour le cube, 43 pour l'octaèdre, 53 pour l'icosaèdre et 35 pour le dodécaèdre.

La macro renvoit le polyèdre en sortie (comme la macro MakePoly), que l'on peut ensuite dessiner avec la macro DrawPoly.

Code de la macro:

Code:

{PolyRegul(Rayon, type) :
  Dessine le polyèdre régulier de centre (0,0,0) et de rayon "Rayon".
  type= "tetra" ou 33, "cube" ou 34 , "octa" ou 43, "icosa" ou 53, "dodeca"  ou 35
  }
[
if StrComp(%2,"tetra") Or StrComp(%2, "33") then
  $R:=%1/sqrt(3),
  $M1:=R*[-1-i,1], $M2:=R*[1+i,1], $M3:=R*[-1+i,-1], $M4:=R*[1-i,-1],
  MakePoly([M1,M2,M3,M4],[1,2,3,jump,1,3,4,jump,1,4,2,jump,2,4,3,jump])
 
elif StrComp(%2,"cube") Or StrComp(%2, "34") then
  $R:=%1/sqrt(3),
  $M1:=R*[-1+i,1], $M2:=R*[-1-i,1], $M3:=R*[1+i,1], $M4:=R*[1-i,1],
  $M5:=R*[-1+i,-1], $M6:=R*[-1-i,-1], $M7:=R*[1+i,-1], $M8:=R*[1-i,-1],
  MakePoly([M1,M2,M3,M4,M5,M6,M7,M8],
      [1,3,7,5,jump,3,4,8,7,jump,2,6,8,4,jump,2,1,5,6,jump,1,2,4,3,jump,5,7,8,6,jump])

elif StrComp(%2,"octa") Or StrComp(%2, "43")  then {octaedre}
  $R:=%1,
  $M1:=R*[0,1], $M2:=R*[-1,0], $M3:=R*[i,0],
  $M4:=R*[-i,0], $M5:=R*[1,0], $M6:=R*[0,-1],
  MakePoly([M1,M2,M3,M4,M5,M6],
      [1,4,5,jump,1,5,3,jump,1,3,2,jump,1,2,4,jump,6,4,2,jump,6,5,4,jump,6,3,5,jump,6,2,3,jump])

elif StrComp(%2,"icosa") Or StrComp(%2, "53")  then
  $p:=(sqrt(5)+1)/2,
  $R:=%1/sqrt(2+p),
  $M1:=R*[-1,p], $M2:=R*[1,p], $M3:=R*[p*i,1], $M4:=R*[-p*i,1],
  $M5:=R*[-p+i,0], $M6:=R*[-p-i,0], $M7:=R*[p+i,0], $M8:=R*[p-i,0],
  $M9:=R*[p*i,-1], $M10:=R*[-p*i,-1], $M11:=R*[-1,-p], $M12:=R*[1,-p],
  MakePoly([M1,M2,M3,M4,M5,M6,M7,M8,M9,M10,M11,M12],
      [1,2,3,jump,1,3,5,jump,1,5,6,jump,1,6,4,jump,1,4,2,jump,
        5,11,6,jump,6,11,10,jump,10,4,6,jump,4,10,8,jump,4,8,2,jump,
        2,8,7,jump,2,7,3,jump,3,7,9,jump,3,9,5,jump,5,9,11,jump,
        12,7,8,jump,12,8,10,jump,12,9,7,jump,12,10,11,jump,12,11,9,jump])
 
elif StrComp(%2,"dodeca")  Or StrComp(%2, "35") then
  $p:=(sqrt(5)+1)/2, $q:=(sqrt(5)-1)/2,
  $R:=%1/sqrt(3),
  $M1:=R*[-q,p], $M2:=R*[q,p], $M3:=R*[-1+i,1], $M4:=R*[-1-i,1],
  $M5:=R*[1+i,1], $M6:=R*[1-i,1], $M7:=R*[p*i,q], $M8:=R*[-p*i,q],
  $M9:=R*[-p+q*i,0], $M10:=R*[-p-q*i,0], $M11:=R*[p+q*i,0], $M12:=R*[p-q*i,0],
  $M13:=R*[p*i,-q], $M14:=R*[-p*i,-q], $M15:=R*[-1+i,-1], $M16:=R*[-1-i,-1],
  $M17:=R*[1+i,-1], $M18:=R*[1-i,-1], $M19:=R*[-q,-p], $M20:=R*[q,-p],
  MakePoly([M1,M2,M3,M4,M5,M6,M7,M8,M9,M10,
                                            M11,M12,M13,M14,M15,M16,M17,M18,M19,M20],
      [1,2,5,7,3,jump, 1,3,9,10,4,jump, 1,4,8,6,2,jump, 2,6,12,11,5,jump,
        15,13,17,20,19,jump, 16,10,9,15,19,jump, 20,18,14,16,19,jump,
        17,11,12,18,20,jump, 16,14,8,4,10,jump,12,6,8,14,18,jump,
        9,3,7,13,15,jump, 17,13,7,5,11,jump])
fi
]

Afin de pouvoir transformer un polyèdre par une transformation géométrique, j'ai ajouté la macro suivante
Map3D( <fonction>, <variable>, <liste de points 3D> )

qui permet de balayer la liste de points de l'espace et pour chacun d'eux calculer son image par la <fonction>. La macro renvoit la liste des résultats, si la liste initiale est un polyèdre, le résultat sera aussi un polyèdre.

Voici son code:

Code:

{ Map3D( <fonction>, <variable>, <liste>): comme la commande Map mais avec des points de l'espace}
[$compt:=0, $P:=1/0,
 for $z in %3 do
  Inc(compt,1),
  if z=jump then z, compt:=0,P:=1/0 else Insert(P,z) fi,
  if compt=2 then Assign(%1,%2,P), %1, P:=1/0, compt:=0 fi
 od
]

Exemple d' utilisation, dans un élément graphique utilisateur:

Code:

[ $P:= PolyRegul( 1, "icosa"),
  $P1:=Map3D( $M-2*vecJ, M, P), DrawPoly(P1,2),
 FillColor:=Rgb(85/255, 85/255, 1),
  $P2:=Map3D( 2*M+2*vecJ, M, P), DrawPoly(P2,2)
]

P est un icosaèdre régulier inscrit dans la sphère unité, P1 est son translaté par le vecteur -2vecJ, P2 est l'image de P par l'homothètie de centre O de rapport 2, suivi de la translation de vecteur 2*vecJ. Puis on dessine P1 et P2 en mode 2 (facettes visibles + arêtes cachées).


_________________
P.Fradin

P.Fradin
Admin

Nombre de messages : 1133
Age : 55
Date d'inscription : 19/01/2008

Voir le profil de l'utilisateur http://texgraph.tuxfamily.org/

Revenir en haut Aller en bas

Re: Polyèdres réguliers

Message  P.Fradin le Sam 19 Jan - 21:52

Grâce au travail remarquable d'Alphonse Capriani, on peut désormais dessiner tous les polyèdres réguliers convexes et non convexes dans TeXgraph avec le fichier suivant: PolyedReg.zip .

Ma contribution a consisté à écrire la macro qui dessine à l'écran les polyèdres, mais c'est Alphonse qui a calculé tous les points pour construire ces polyèdres facette par facette! Ce qui représente un sacré boulot.

Pour ceux qui (comme moi il y a encore quelques jours) ne connaissent pas les polyèdres réguliers non convexes, je les ai mis en animations flash:

le petit dodécaèdre étoilé

le grand dodécaèdre étoilé

le grand dodécaèdre

et le grand icosaèdre

Un grand merci à Alphonse!

Je rajoute un fichier pdf qui contient quelques explications d'Alphonse Capriani sur les quatre polyèdres réguliers non convexes: PolyedReg.pdf.

_________________
P.Fradin

P.Fradin
Admin

Nombre de messages : 1133
Age : 55
Date d'inscription : 19/01/2008

Voir le profil de l'utilisateur http://texgraph.tuxfamily.org/

Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum