Yukterez

Polyhedron

Oct 18th, 2018
146
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (* Syntax: Mathematica | Code: Simon Tyran, Vienna, yukterez.net *)
  2. R1=PolyhedronData["SmallStellatedDodecahedron","Circumradius"];
  3. R2=PolyhedronData["Icosahedron","Circumradius"];
  4. R=R1/R2;
  5. Xyz[{x_,y_,z_},α_]:={x Cos[α π/180]-y Sin[α π/180],x Sin[α π/180]+y Cos[α π/180],z};
  6. xyZ[{x_,y_,z_},β_]:={x Cos[β π/180]+z Sin[β π/180],y,z Cos[β π/180]-x Sin[β π/180]};
  7. Manipulate[Show[
  8. Graphics3D[{Opacity[n],
  9. GraphicsComplex[R {
  10. (*01*) {0,0,-(5/Sqrt[50-10 Sqrt[5]])},
  11. (*02*) {0,0,5/Sqrt[50-10 Sqrt[5]]},
  12. (*03*) {-Sqrt[(2/(5-Sqrt[5]))],0,-(1/Sqrt[10-2 Sqrt[5]])},
  13. (*04*) {Sqrt[2/(5-Sqrt[5])],0,1/Sqrt[10-2 Sqrt[5]]},
  14. (*05*) {(1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]]),-(1/2),-(1/Sqrt[10-2 Sqrt[5]])},
  15. (*06*) {(1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]]),1/2,-(1/Sqrt[10-2 Sqrt[5]])},
  16. (*07*) {-((1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]])),-(1/2),1/Sqrt[10-2 Sqrt[5]]},
  17. (*08*) {-((1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]])),1/2,1/Sqrt[10-2 Sqrt[5]]},
  18. (*09*) {-((-1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]])),-(1/2) Sqrt[(5+Sqrt[5])/(5-Sqrt[5])],-(1/Sqrt[10-2 Sqrt[5]])},
  19. (*10*) {-((-1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]])),1/2 Sqrt[(5+Sqrt[5])/(5-Sqrt[5])],-(1/Sqrt[10-2 Sqrt[5]])},
  20. (*11*) {(-1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]]),-(1/2) Sqrt[(5+Sqrt[5])/(5-Sqrt[5])],1/Sqrt[10-2 Sqrt[5]]},
  21. (*12*) {(-1+Sqrt[5])/(2 Sqrt[10-2 Sqrt[5]]),1/2 Sqrt[(5+Sqrt[5])/(5-Sqrt[5])],1/Sqrt[10-2 Sqrt[5]]}},
  22. Polygon[{
  23. {02,12,08},
  24. {02,08,07},
  25. {02,07,11},
  26. {02,11,04},
  27. {02,04,12},
  28. {05,09,01},
  29. {06,05,01},
  30. {10,06,01},
  31. {03,10,01},
  32. {09,03,01},
  33. {12,10,08},
  34. {08,03,07},
  35. {07,09,11},
  36. {11,05,04},
  37. {04,06,12},
  38. {05,11,09},
  39. {06,04,05},
  40. {10,12,06},
  41. {03,08,10},
  42. {09,07,03}}]]},
  43. Boxed->False],
  44. Graphics3D[{Rotate[Rotate[
  45. GraphicsComplex[{
  46. (*01*) {-(1/Sqrt[3]),0,Root[1-84 #1^2+144 #1^4&,2]},
  47. (*02*) {-(1/(2 Sqrt[3])),-(1/2),Root[1-84 #1^2+144 #1^4&,3]},
  48. (*03*) {-(1/(2 Sqrt[3])),1/2,Root[1-84 #1^2+144 #1^4&,3]},
  49. (*04*) {1/(2 Sqrt[3]),-(1/2),Root[1-84 #1^2+144 #1^4&,2]},
  50. (*05*) {1/(2 Sqrt[3]),1/2,Root[1-84 #1^2+144 #1^4&,2]},
  51. (*06*) {1/Sqrt[3],0,Root[1-84 #1^2+144 #1^4&,3]},
  52. (*07*) {Root[1-9 #1^2+9 #1^4&,2],0,Sqrt[1/8+Sqrt[5]/24]},
  53. (*08*) {Sqrt[1/6 (3-Sqrt[5])],0,-(1/2) Sqrt[1/6 (3+Sqrt[5])]},
  54. (*09*) {Root[1-36 #1^2+144 #1^4&,2],1/4 (1-Sqrt[5]),-(1/2) Sqrt[1/6 (3+Sqrt[5])]},
  55. (*10*) {Root[1-36 #1^2+144 #1^4&,2],1/4 (-1+Sqrt[5]),-(1/2) Sqrt[1/6 (3+Sqrt[5])]},
  56. (*11*) {Root[1-36 #1^2+144 #1^4&,3],1/4 (1-Sqrt[5]),Sqrt[1/8+Sqrt[5]/24]},
  57. (*12*) {Root[1-36 #1^2+144 #1^4&,3],1/4 (-1+Sqrt[5]),Sqrt[1/8+Sqrt[5]/24]}},
  58. Polygon[{
  59. {02,12,01,11,03},
  60. {10,04,01,08,02},
  61. {03,08,01,05,09},
  62. {09,11,01,04,07},
  63. {07,05,01,12,10},
  64. {07,10,02,03,09},
  65. {04,12,02,06,07},
  66. {09,06,02,08,11},
  67. {07,06,03,11,05},
  68. {12,08,03,06,10},
  69. {09,05,04,10,06},
  70. {08,12,04,05,11}}]],
  71. 37.5 π/180,{0,1,0}],
  72. 36.0 π/180,{0,0,1}]}],
  73. Graphics3D[{Opacity[0.1],
  74. Sphere[{0,0,0},R1]}],
  75. ViewPoint->Xyz[xyZ[{1000,0,0},δ+90],γ],
  76. SphericalRegion->True,
  77. ImageSize->604],
  78. {{n,0.3},0,1},
  79. {δ,1,180},
  80. {γ,0,360}]
RAW Paste Data