Polyèdres réguliers

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).

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.