Gyroelongated Square Dipyramid to Tetrahedron Net Dissection

ver3D=PolyhedronData["GyroelongatedSquareDipyramid","VertexCoordinates"]//N;

al1=Pi-ArcSec[3]//N;

al2=ArcCos[Normalize[Cross[ver3D[[1]]-ver3D[[2]],ver3D[[9]]-ver3D[[2]]]].Normalize[Cross[ver3D[[9]]-ver3D[[2]],ver3D[[6]]-ver3D[[2]]]]];

al3=ArcCos[Normalize[Cross[ver3D[[2]]-ver3D[[1]],ver3D[[3]]-ver3D[[1]]]].Normalize[Cross[ver3D[[9]]-ver3D[[1]],ver3D[[2]]-ver3D[[1]]]]];

al4=Pi-1.9106332362490186`;

from2Dto3D[r_]:={r[[1]],r[[2]],0};

vertices=Map[from2Dto3D,PolyhedronData["GyroelongatedSquareDipyramid","NetCoordinates"]];

triangle3D[i_]:=GraphicsComplex[Map[from2Dto3D,PolyhedronData["GyroelongatedSquareDipyramid","NetCoordinates"]],Polygon[PolyhedronData["GyroelongatedSquareDipyramid","NetFaceIndices"][[i]]]];

tetra[k_,r1_]:=Module[{r2=r1},Graphics3D[{RGBColor[1, 0.501961, 0.501961],EdgeForm[Blue],Rotate[{Rotate[{triangle3D[1],triangle3D[2],triangle3D[3],triangle3D[13]},r1 al1,vertices[[6]]-vertices[[4]],vertices[[4]]],{triangle3D[4],triangle3D[14],Translate[triangle3D[9],2k{0.5,-Sqrt[3]/2,0}],Translate[triangle3D[10],2k{0.5,-Sqrt[3]/2,0}]}},r2 al1,vertices[[10]]-vertices[[12]],vertices[[12]]],{triangle3D[5],triangle3D[6],triangle3D[7],triangle3D[15]},Rotate[{triangle3D[8],triangle3D[16],Translate[triangle3D[11],2k{0.5,-Sqrt[3]/2,0}],Translate[triangle3D[12],2k{0.5,-Sqrt[3]/2,0}]},-r1 al1,vertices[[14]]-vertices[[12]],vertices[[12]]]},Axes->False,PlotRange->{{-0.1,5},{-0.1,5},{-0.1,5}},SphericalRegion->True,Boxed->False,ImageSize->{450,450}]];

giro[r1_]:=Module[{r2=r1,r3=r1,r4=r1,r5=r1},Graphics3D[{Rotate[{Rotate[{Rotate[{Rotate[triangle3D[9],r1 al3,vertices[[5]]-vertices[[1]],vertices[[1]]],triangle3D[1]},r2 al2,vertices[[5]]-vertices[[2]],vertices[[2]]],Rotate[triangle3D[13],-r1 al3,vertices[[6]]-vertices[[2]],vertices[[6]]],triangle3D[2]},r3 al2,vertices[[5]]-vertices[[6]],vertices[[6]]],Rotate[triangle3D[10],r1 al3,vertices[[9]]-vertices[[5]],vertices[[5]]],triangle3D[3]},r4 al2,vertices[[9]]-vertices[[6]],vertices[[6]]],Rotate[triangle3D[14],-r1 al3,vertices[[10]]-vertices[[6]],vertices[[6]]],triangle3D[4],Rotate[{Rotate[triangle3D[11],r1 al3,vertices[[13]]-vertices[[9]],vertices[[9]]],triangle3D[5],Rotate[{Rotate[triangle3D[15],-r1 al3,vertices[[14]]-vertices[[10]],vertices[[14]]],triangle3D[6],Rotate[{Rotate[triangle3D[12],r1 al3,vertices[[17]]-vertices[[13]],vertices[[13]]],triangle3D[7],Rotate[{triangle3D[8],Rotate[triangle3D[16],-r1 al3,vertices[[18]]-vertices[[14]],vertices[[14]]]},-r2 al2,vertices[[17]]-vertices[[14]],vertices[[14]]]},-r3 al2,vertices[[13]]-vertices[[14]],vertices[[14]]]},-r4 al2,vertices[[13]]-vertices[[10]],vertices[[10]]]},-r5 al2,vertices[[9]]-vertices[[10]],vertices[[10]]](*,Table[Text[Style[i,16],vertices[[i]]],{i,1,Length[vertices]}]*)},PlotRange->{{-0.1,5},{-0.1,5},{-0.1,5}},SphericalRegion->True,Boxed->False,ImageSize->{450,420}]];
tetra4[r1_]:=Module[{},Graphics3D[{Rotate[{Rotate[triangle3D[9],r1 al1,vertices[[5]]-vertices[[1]],vertices[[1]]],triangle3D[1]},r1 al1,vertices[[5]]-vertices[[2]],vertices[[2]]],triangle3D[2],Rotate[triangle3D[13],-r1 al1,vertices[[6]]-vertices[[2]],vertices[[2]]],
Rotate[{Rotate[triangle3D[10],r1 al1,vertices[[9]]-vertices[[5]],vertices[[5]]],triangle3D[3]},r1 al1,vertices[[9]]-vertices[[6]],vertices[[6]]],triangle3D[4],Rotate[triangle3D[14],-r1 al1,vertices[[10]]-vertices[[6]],vertices[[6]]],

Rotate[{Rotate[triangle3D[11],r1 al1,vertices[[13]]-vertices[[9]],vertices[[9]]],triangle3D[5]},r1 al1,vertices[[13]]-vertices[[10]],vertices[[10]]],triangle3D[6],Rotate[triangle3D[15],-r1 al1,vertices[[14]]-vertices[[10]],vertices[[10]]],

Rotate[{Rotate[triangle3D[12],r1 al1,vertices[[17]]-vertices[[13]],vertices[[13]]],triangle3D[7]},r1 al1,vertices[[17]]-vertices[[14]],vertices[[14]]],triangle3D[8],Rotate[triangle3D[16],-r1 al1,vertices[[18]]-vertices[[14]],vertices[[14]]]},PlotRange->{{-0.1,5},{-0.1,5},{-0.1,5}},SphericalRegion->True,Boxed->False,ImageSize->{450,420}]];
octa2[k_,r1_]:=Module[{k1=k},Graphics3D[{Rotate[{Rotate[Translate[triangle3D[10],k1(vertices[[1]]-vertices[[7]])],r1 al4,vertices[[1]]-vertices[[2]],vertices[[2]]]
,Rotate[triangle3D[9],r1 al4,vertices[[5]]-vertices[[1]],vertices[[1]]]
,triangle3D[1]},r1 al4,vertices[[5]]-vertices[[2]],vertices[[2]]]
,triangle3D[2],
Rotate[triangle3D[3],-r1 al4,vertices[[5]]-vertices[[6]],
vertices[[6]]],
Rotate[{triangle3D[13],
Rotate[{Translate[triangle3D[4],k1(vertices[[6]]-vertices[[9]])],Rotate[Translate[triangle3D[14],k1(vertices[[6]]-vertices[[9]])],-r1 al4,vertices[[8]]-vertices[[4]],vertices[[4]]]},-r1 al4,vertices[[6]]-vertices[[4]],vertices[[4]]]},-r1 al4,vertices[[6]]-vertices[[2]],vertices[[2]]],
Rotate[{Rotate[Translate[triangle3D[12],k1(vertices[[1]]-vertices[[7]])],r1 al4,vertices[[1]]-vertices[[2]],vertices[[10]]]
,Rotate[triangle3D[11],r1 al4,vertices[[5]]-vertices[[1]],vertices[[9]]]
,triangle3D[5]},r1 al4,vertices[[5]]-vertices[[2]],vertices[[10]]]
,triangle3D[6],
Rotate[triangle3D[7],-r1 al4,vertices[[5]]-vertices[[6]],
vertices[[14]]],
Rotate[{triangle3D[15],
Rotate[{Translate[triangle3D[8],k1(vertices[[6]]-vertices[[9]])],Rotate[Translate[triangle3D[16],k1(vertices[[6]]-vertices[[9]])],-r1 al4,vertices[[8]]-vertices[[4]],vertices[[12]]]},-r1 al4,vertices[[6]]-vertices[[4]],vertices[[12]]]},-r1 al4,vertices[[6]]-vertices[[2]],vertices[[10]]]
},PlotRange->{{-1,5},{-1,4},{-2,2}},SphericalRegion->True,Boxed->False,ImageSize->{450,420}]];

Manipulate[Switch[poly,1,giro[r1],2,tetra[k,r1],3,tetra4[r1],4,octa2[k,r1]],Control[{{poly,1,""},{1->"GyroelongatedSquareDipyramid",2->"Tetrahedron",3->"Four tetrahedra",4->"Two octahedra"}}],{{k,0,"translate to net"},0,1,Enabled->poly==2 ||poly==4},{{r1,0,"fold/unfold"},0,1,Enabled->Implies[poly==2,k==1]},SaveDefinitions->True]

The Demonstration shows  dissection of a net of gyroelongated square dipyramid to a net of tetrahedron,  to nets of four tetrahedra, or to nets of two octahedra.

G. N. Frederickson, Dissections: Plane & Fancy, New York: Cambridge University Press, 2002 p. 246.

Contributed by: Izidor Hafner