Yukterez

Triacontahedron

Nov 4th, 2018
135
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (* Syntax: Wolfram, Code: Simon Tyran, Vienna, yukterez.net *)
  2.  
  3. ecken={
  4. {0,0,1/2 (-1-Sqrt[5])},
  5. {0,0,1/2 (1+Sqrt[5])},
  6. {1/10 (5-Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5+3 Sqrt[5])},
  7. {1/10 (5-Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5+3 Sqrt[5])},
  8. {2/Sqrt[5],0,1/10 (5+3 Sqrt[5])},
  9. {1/10 (5+3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5+Sqrt[5])},
  10. {1/10 (5+3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5+Sqrt[5])},
  11. {1/10 (5+3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5+Sqrt[5])},
  12. {1/10 (5+3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5+Sqrt[5])},
  13. {-(2/Sqrt[5]),0,1/10 (-5-3 Sqrt[5])},
  14. {-(1/Sqrt[5]),-Sqrt[1+2/Sqrt[5]],1/10 (5+Sqrt[5])},
  15. {-(1/Sqrt[5]),-Sqrt[1+2/Sqrt[5]],1/10 (-5+Sqrt[5])},
  16. {-(1/Sqrt[5]),Sqrt[1+2/Sqrt[5]],1/10 (5+Sqrt[5])},
  17. {-(1/Sqrt[5]),Sqrt[1+2/Sqrt[5]],1/10 (-5+Sqrt[5])},
  18. {1/Sqrt[5],-Sqrt[1+2/Sqrt[5]],1/10 (5-Sqrt[5])},
  19. {1/Sqrt[5],-Sqrt[1+2/Sqrt[5]],1/10 (-5-Sqrt[5])},
  20. {1/Sqrt[5],Sqrt[1+2/Sqrt[5]],1/10 (5-Sqrt[5])},
  21. {1/Sqrt[5],Sqrt[1+2/Sqrt[5]],1/10 (-5-Sqrt[5])},
  22. {-1-1/Sqrt[5],0,1/10 (5+Sqrt[5])},
  23. {-1-1/Sqrt[5],0,1/10 (-5+Sqrt[5])},
  24. {1/10 (-5-Sqrt[5]),Root[1-5 #1^2+5 #1^4&,2],1/10 (5+3 Sqrt[5])},
  25. {1/10 (-5-Sqrt[5]),Sqrt[2/(5+Sqrt[5])],1/10 (5+3 Sqrt[5])},
  26. {1/10 (5+Sqrt[5]),Root[1-5 #1^2+5 #1^4&,2],1/10 (-5-3 Sqrt[5])},
  27. {1/10 (5+Sqrt[5]),Sqrt[2/(5+Sqrt[5])],1/10 (-5-3 Sqrt[5])},
  28. {1+1/Sqrt[5],0,1/10 (5-Sqrt[5])},
  29. {1+1/Sqrt[5],0,1/10 (-5-Sqrt[5])},
  30. {1/10 (-5-3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (5-Sqrt[5])},
  31. {1/10 (-5-3 Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5-Sqrt[5])},
  32. {1/10 (-5-3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (5-Sqrt[5])},
  33. {1/10 (-5-3 Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5-Sqrt[5])},
  34. {1/10 (-5+Sqrt[5]),Root[1-5 #1^2+5 #1^4&,1],1/10 (-5-3 Sqrt[5])},
  35. {1/10 (-5+Sqrt[5]),Sqrt[1/10 (5+Sqrt[5])],1/10 (-5-3 Sqrt[5])}};
  36.  
  37. polygon={
  38. {16,15,11,12},
  39. {14,13,17,18},
  40. {10,28,20,30},
  41. {8,5,6,25},
  42. {12,28,31,16},
  43. {32,30,14,18},
  44. {6,3,11,15},
  45. {8,17,13,4},
  46. {11,21,19,27},
  47. {13,29,19,22},
  48. {7,16,23,26},
  49. {24,18,9,26},
  50. {12,11,27,28},
  51. {30,29,13,14},
  52. {7,6,15,16},
  53. {18,17,8,9},
  54. {2,22,19,21},
  55. {23,1,24,26},
  56. {3,2,21,11},
  57. {4,13,22,2},
  58. {16,31,1,23},
  59. {1,32,18,24},
  60. {31,28,10,1},
  61. {10,30,32,1},
  62. {6,5,2,3},
  63. {8,4,2,5},
  64. {28,27,19,20},
  65. {20,19,29,30},
  66. {26,25,6,7},
  67. {9,8,25,26}};
  68.  
  69. x1=Max[ecken[[All, 1]]];
  70. x2=Max[ecken[[All, 2]]];
  71. x3=Max[ecken[[All, 3]]];
  72.  
  73. f[α_,β_,δ_]:=RotationMatrix[α π/180,{0,1,0}].(RotationMatrix[β π/180,{0,0,1}].(RotationMatrix[δ π/180,{1,0,0}]));
  74. solve[p_]:=Quiet[N[Reduce[x==pts[1, p, 1]]]];
  75.  
  76. plane[p_,c_]:=InfinitePlane[Evaluate[Table[c ecken[[polygon[[p,k]]]],{k,2,4}]]];
  77. cube[b_]:=Cuboid[b{-x1,-x2,-x3},b{+x1,+x2,+x3}];
  78. 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]];
  79. opar=1; isize=400;
  80.  
  81. plot[vp_,n_,ζ_,ς_,p_,s_,b_,r_,c_,ξ_,h_,α_,β_,δ_]:=Show[
  82.  
  83. Graphics3D[{
  84. Opacity[n],EdgeForm[Thickness[0.003]],Rotate[Rotate[Rotate[
  85. GraphicsComplex[ecken,
  86. Polygon[polygon]],
  87. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
  88.  
  89. Graphics3D[
  90. {Opacity[ς],EdgeForm[Thickness[0.001]],FaceForm[Darker[Blue]],
  91. Rotate[Rotate[Rotate[
  92. InfinitePlane[Evaluate[Table[c ecken[[polygon[[p,k]]]],{k,2,4}]]],
  93. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
  94.  
  95. Graphics3D[
  96. {Opacity[1],EdgeForm[Thickness[0.003]],FaceForm[Darker[Red]],Rotate[Rotate[Rotate[
  97. GraphicsComplex[s ecken,
  98. Polygon[polygon[[p]]]],
  99. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
  100.  
  101. Graphics3D[
  102. {Opacity[1],EdgeForm[Thickness[0.003]],FaceForm[Darker[Red]],Rotate[Rotate[Rotate[
  103. GraphicsComplex[s ecken,
  104. Polygon[polygon[[p]]]],
  105. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
  106.  
  107. Graphics3D[
  108. {Opacity[ζ],EdgeForm[Thickness[0.003]],
  109. Rotate[Rotate[Rotate[
  110. cube[b],
  111. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}]},SphericalRegion->True],
  112.  
  113. If[1.0 α==0.,If[1.0 β==0.,If[1.0 δ==0.,If[h>0,If[p>2,
  114. Quiet[ContourPlot3D[Evaluate[q==pts[1,p,1]],{q,-x1,+x1},{y,-x2,+x2},{z,-x3,+x3},
  115. ContourStyle->Directive[Orange,Opacity[h],Specularity[White,30]]]],
  116. {}],{}],{}],{}],{}],
  117.  
  118. If[ξ>0,
  119. Graphics3D[
  120. Rotate[Rotate[Rotate[
  121. {Opacity[opar],EdgeForm[Thickness[0.003]],Blue,Arrow[{{0,0,0},{2.1,0,0}}]},
  122. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  123. {}],
  124.  
  125. If[ξ>0,
  126. Graphics3D[
  127. Rotate[Rotate[Rotate[
  128. {Opacity[opar],EdgeForm[Thickness[0.003]],Red,Arrow[{{0,0,0},{0,2.1,0}}]},
  129. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  130. {}],
  131.  
  132. If[ξ>0,
  133. Graphics3D[
  134. Rotate[Rotate[Rotate[
  135. {Opacity[opar],EdgeForm[Thickness[0.003]],Darker[Green],Arrow[{{0,0,0},{0,0,2.1}}]},
  136. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  137. {}],
  138.  
  139. If[ξ>0,
  140. Graphics3D[
  141. Rotate[Rotate[Rotate[
  142. {Opacity[opar],EdgeForm[Thickness[0.003]],Blue,Line[{{0,0,0},{-2,0,0}}]},
  143. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  144. {}],
  145.  
  146. If[ξ>0,
  147. Graphics3D[
  148. Rotate[Rotate[Rotate[
  149. {Opacity[opar],EdgeForm[Thickness[0.003]],Red,Line[{{0,0,0},{0,-2,0}}]},
  150. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  151. {}],
  152.  
  153. If[ξ>0,
  154. Graphics3D[
  155. Rotate[Rotate[Rotate[
  156. {Opacity[opar],EdgeForm[Thickness[0.003]],Darker[Green],Line[{{0,0,0},{0,0,-2}}]},
  157. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  158. {}],
  159.  
  160. If[ξ>0,
  161. Graphics3D[
  162. Rotate[Rotate[Rotate[
  163. {Opacity[opar],PointSize[0.02],Blue,Point[{-2,0,0}]},
  164. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  165. {}],
  166.  
  167. If[ξ>0,
  168. Graphics3D[
  169. Rotate[Rotate[Rotate[
  170. {Opacity[opar],PointSize[0.02],Red,Point[{0,-2,0}]},
  171. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  172. {}],
  173.  
  174. If[ξ>0,
  175. Graphics3D[
  176. Rotate[Rotate[Rotate[
  177. {Opacity[opar],PointSize[0.02],Darker[Green],Point[{0,0,-2}]},
  178. α π/180,{0,1,0}],β π/180,{0,0,1}],δ π/180,{1,0,0}],SphericalRegion->True],
  179. {}],
  180.  
  181. PlotRange->r,ViewPoint->vp,SphericalRegion->True,ImageSize->isize,Boxed->False];
  182.  
  183. VP={{0,0,Infinity},{0,Infinity,0},{Infinity,0,0},{0,0,-Infinity},{0,-Infinity,0},{-Infinity,0,0}};
  184. X0=x1; Y0=x2; Z0=x3;
  185. T[text_, color_] := Style[text, FontSize->11, color];
  186.  
  187. construct=Manipulate[
  188. Grid[{
  189. {Rasterize[plot[w VP[[1]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize],
  190. Rasterize[plot[w VP[[2]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize]},
  191. {Rasterize[plot[w VP[[3]],n,ζ,ς,p,s,b,r,c,ξ,h,α,β,δ], ImageSize->isize],
  192. plot[1 VP[[6]],n,ζ,ς,p,s,b,r,c,ξ,h,0,0,0]},
  193. {
  194. 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]}
  195. }],
  196. Grid[{{{T["α"->α,Black]},{T["β"->β,Black]},{T["δ"->δ,Black]}},
  197. {{T["±X"->x1 1., Blue]}, {T["±Y"->x2 1., Red]}, {T["±Z"->x3 1., Darker[Green]]}}
  198. }]}}],
  199. {{n,1},0,1},
  200. {{ζ,0.1},0,1},
  201. {{ς,0.1},0,1/2},
  202. {{r,2.7},1/3,10},
  203. {{p,4},1,Length[polygon],1},
  204. {{s,1.01},1,2},
  205. {{b,1},0,1,1},
  206. {{ξ,1},0,1,1},
  207. {{c,-10},-10,1,11},
  208. {{h,0.4},0,1,0.2},
  209. {{w,1},-1,1,2},
  210. {α,0,360,1},
  211. {β,0,360,1},
  212. {δ,0,360,1}
  213. ];
  214.  
  215. construct
RAW Paste Data