Code: Alles auswählen
(* Syntax: Wolfram, Code: Simon Tyran, Vienna, yukterez.net *)
ecken={
{0,0,1/2 (-1-Sqrt[5])},
{0,0,1/2 (1+Sqrt[5])},
{1/10 (5-Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5+3 Sqrt[5])},
{1/10 (5-Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5+3 Sqrt[5])},
{2/Sqrt[5],0,1/10 (5+3 Sqrt[5])},
{1/10 (5+3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5+Sqrt[5])},
{1/10 (5+3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5+Sqrt[5])},
{1/10 (5+3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5+Sqrt[5])},
{1/10 (5+3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5+Sqrt[5])},
{-(2/Sqrt[5]),0,1/10 (-5-3 Sqrt[5])},
{-(1/Sqrt[5]),-Sqrt[1+2/Sqrt[5]],1/10 (5+Sqrt[5])},
{-(1/Sqrt[5]),-Sqrt[1+2/Sqrt[5]],1/10 (-5+Sqrt[5])},
{-(1/Sqrt[5]),Sqrt[1+2/Sqrt[5]],1/10 (5+Sqrt[5])},
{-(1/Sqrt[5]),Sqrt[1+2/Sqrt[5]],1/10 (-5+Sqrt[5])},
{1/Sqrt[5],-Sqrt[1+2/Sqrt[5]],1/10 (5-Sqrt[5])},
{1/Sqrt[5],-Sqrt[1+2/Sqrt[5]],1/10 (-5-Sqrt[5])},
{1/Sqrt[5],Sqrt[1+2/Sqrt[5]],1/10 (5-Sqrt[5])},
{1/Sqrt[5],Sqrt[1+2/Sqrt[5]],1/10 (-5-Sqrt[5])},
{-1-1/Sqrt[5],0,1/10 (5+Sqrt[5])},
{-1-1/Sqrt[5],0,1/10 (-5+Sqrt[5])},
{1/10 (-5-Sqrt[5]),Root[1-5 #1^2+5 #1^4&,2],1/10 (5+3 Sqrt[5])},
{1/10 (-5-Sqrt[5]),Sqrt[2/(5+Sqrt[5])],1/10 (5+3 Sqrt[5])},
{1/10 (5+Sqrt[5]),Root[1-5 #1^2+5 #1^4&,2],1/10 (-5-3 Sqrt[5])},
{1/10 (5+Sqrt[5]),Sqrt[2/(5+Sqrt[5])],1/10 (-5-3 Sqrt[5])},
{1+1/Sqrt[5],0,1/10 (5-Sqrt[5])},
{1+1/Sqrt[5],0,1/10 (-5-Sqrt[5])},
{1/10 (-5-3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5-Sqrt[5])},
{1/10 (-5-3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5-Sqrt[5])},
{1/10 (-5-3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5-Sqrt[5])},
{1/10 (-5-3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5-Sqrt[5])},
{1/10 (-5+Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5-3 Sqrt[5])},
{1/10 (-5+Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5-3 Sqrt[5])}};
polygon={
{16,15,11,12},
{14,13,17,18},
{10,28,20,30},
{8,5,6,25},
{12,28,31,16},
{32,30,14,18},
{6,3,11,15},
{8,17,13,4},
{11,21,19,27},
{13,29,19,22},
{7,16,23,26},
{24,18,9,26},
{12,11,27,28},
{30,29,13,14},
{7,6,15,16},
{18,17,8,9},
{2,22,19,21},
{23,1,24,26},
{3,2,21,11},
{4,13,22,2},
{16,31,1,23},
{1,32,18,24},
{31,28,10,1},
{10,30,32,1},
{6,5,2,3},
{8,4,2,5},
{28,27,19,20},
{20,19,29,30},
{26,25,6,7},
{9,8,25,26}};
x1=Max[ecken[[All, 1]]];
x2=Max[ecken[[All, 2]]];
x3=Max[ecken[[All, 3]]];
f[α_,β_,δ_]:=RotationMatrix[α π/180,{0,1,0}].(RotationMatrix[β π/180,{0,0,1}].(RotationMatrix[δ π/180,{1,0,0}]));
solve[p_]:=Quiet[N[Reduce[x==pts[1, p, 1]]]];
plane[p_,c_]:=InfinitePlane[Evaluate[Table[c ecken[[polygon[[p,k]]]],{k,2,4}]]];
cube[b_]:=Cuboid[b{-x1,-x2,-x3},b{+x1,+x2,+x3}];
pts[b_, p_,c_]:=Normal[Evaluate[Solve[{q,y,z}\[Element]plane[p,c]&&{q,y,z}\[Element]cube[b],{q,y,z},Reals]]][[1,1,2]];
opar=1; isize=400;
plot[vp_,n_,ζ_,ς_,p_,s_,b_,r_,c_,ξ_,h_,α_,β_,δ_]:=Show[
Graphics3D[{
Opacity[n],EdgeForm[Thickness[0.003]],Rotate[Rotate[Rotate[
GraphicsComplex[ecken,
Polygon[polygon]],
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
Graphics3D[
{Opacity[ς],EdgeForm[Thickness[0.001]],FaceForm[Darker[Blue]],
Rotate[Rotate[Rotate[
InfinitePlane[Evaluate[Table[c ecken[[polygon[[p,k]]]],{k,2,4}]]],
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
Graphics3D[
{Opacity[1],EdgeForm[Thickness[0.003]],FaceForm[Darker[Red]],Rotate[Rotate[Rotate[
GraphicsComplex[s ecken,
Polygon[polygon[[p]]]],
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
Graphics3D[
{Opacity[1],EdgeForm[Thickness[0.003]],FaceForm[Darker[Red]],Rotate[Rotate[Rotate[
GraphicsComplex[s ecken,
Polygon[polygon[[p]]]],
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
Graphics3D[
{Opacity[ζ],EdgeForm[Thickness[0.003]],
Rotate[Rotate[Rotate[
cube[b],
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
If[1.0 α==0.,If[1.0 β==0.,If[1.0 δ==0.,If[h>0,If[p>2,
Quiet[ContourPlot3D[Evaluate[q==pts[1,p,1]],{q,-x1,+x1},{y,-x2,+x2},{z,-x3,+x3},
ContourStyle->Directive[Orange,Opacity[h],Specularity[White,30]]]],
{}],{}],{}],{}],{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Blue,Arrow[{{0,0,0},{2.1,0,0}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Red,Arrow[{{0,0,0},{0,2.1,0}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Darker[Green],Arrow[{{0,0,0},{0,0,2.1}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Blue,Line[{{0,0,0},{-2,0,0}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Red,Line[{{0,0,0},{0,-2,0}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],EdgeForm[Thickness[0.003]],Darker[Green],Line[{{0,0,0},{0,0,-2}}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],PointSize[0.02],Blue,Point[{-2,0,0}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],PointSize[0.02],Red,Point[{0,-2,0}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
If[ξ>0,
Graphics3D[
Rotate[Rotate[Rotate[
{Opacity[opar],PointSize[0.02],Darker[Green],Point[{0,0,-2}]},
α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
{}],
PlotRange->r,ViewPoint->vp,SphericalRegion->True,ImageSize->isize,Boxed->False];
VP={{0,0,Infinity},{0,Infinity,0},{Infinity,0,0},{0,0,-Infinity},{0,-Infinity,0},{-Infinity,0,0}};
X0=x1; Y0=x2; Z0=x3;
T[text_, color_] := Style[text, FontSize->11, color];
construct=Manipulate[
Grid[{
{Rasterize[plot[w VP[[1]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize],
Rasterize[plot[w VP[[2]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize]},
{Rasterize[plot[w VP[[3]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize],
plot[1 VP[[6]],n,ζ,ς,p,s,b,r,c,ξ,h,0,0,0]},
{
Grid[{{T["x"==x/.Solve[solve[p],x],Black]},{T["y"==y/.Solve[solve[p],y],Black]},{T["z"==z/.Solve[solve[p],z],Black]}
}],
Grid[{{{T["α"->α,Black]},{T["β"->β,Black]},{T["δ"->δ,Black]}},
{{T["±X"->x1 1., Blue]}, {T["±Y"->x2 1., Red]}, {T["±Z"->x3 1., Darker[Green]]}}
}]}}],
{{n,1},0,1},
{{ζ,0.1},0,1},
{{ς,0.1},0,1/2},
{{r,2.7},1/3,10},
{{p,4},1,Length[polygon],1},
{{s,1.01},1,2},
{{b,1},0,1,1},
{{ξ,1},0,1,1},
{{c,-10},-10,1,11},
{{h,0.4},0,1,0.2},
{{w,1},-1,1,2},
{α,0,360,1},
{β,0,360,1},
{δ,0,360,1}
];
constructTriacontahedron: Wenn die Kantenlängen A..B=1, A..C=2·Sin(ArcTan(2/(1+√5)))=1.05146 und B..D=1.7013 (B..D=A..C·Ф wobei Ф der goldene Schnitt ist), so sind die Längen des Kuboids {x, y, z}={2+2/√5, 2·√(1+2/√5), 1+√5}={2.89443, 2.75276, 3.23607}; der dihedrale Winkel ist 144° und die Rhombuswinkel 148.2825° & 31.7175°. Ecken (Vertices): 32, Kanten (Edges): 60, Gesichtsflächen (Rhomben): 30.
Netz aus 30 gleichseitigen Rhomben:
Animation mit den 5 wichtigsten Gesichtern und ihren Schnittintersektionen mit dem umhüllenden Kuboid:
Videos, Top Front Links Rechts Ansicht:
Schnittintersektionen für alle Rhomben:
Rhombus 1, Kuboidausrichtung 0° bzw. 180°:
Rhombus 2, Kuboidausrichtung 162° bzw. 342°:
Rhombus 3, Kuboidausrichtung 54° bzw. 234°:
Rhombus 4, Kuboidausrichtung 54° bzw. 234°:
Rhombus 5, Kuboidausrichtung 36° bzw. 216°:
Beispiel: Berechnung der Schnitthöhen am Kuboid:
Mit der Lösung für x, y & z aus der linken unteren Spalten des oberen Plots erhalten wir die gelb unterlegten Schnittstellen:
Dabei ist wieder die längere Schnittmarkierung 1.34165 auf der z-Kante des Kuboids der goldene Schnitt Φ mal der kürzeren Markierung 0.829184 auf der x-Kante. Interaktives Arbeitsblatt: triacontahedron.cdf (kann mit dem kostenlosen cdf-Player abgespielt werden). Version 2: icosahedron.vs.dodecahedron.vs.triacontrahedron.compound.nb
