好玩的Mathematica编程

最新推荐文章于 2022-04-09 04:00:00 发布

好玩的Matlab（NCEPU）

最新推荐文章于 2022-04-09 04:00:00 发布

阅读量1.7k

点赞数 2

分类专栏： Mathematica 文章标签：好玩的Mathematica编程

转载请添加备注来源于：https://blog.csdn.net/zzx2016zzx，微信：idmatlab

本文链接：https://blog.csdn.net/zzx2016zzx/article/details/104163960

版权

Mathematica 专栏收录该内容

1 篇文章 1 订阅

订阅专栏

1、复杂多面体

Ry[t_] := {{Cos[t], 0, Sin[t]}, {0, 1, 0}, {-Sin[t], 0, Cos[t]}}; 
Rz[t_] := {{Cos[t], -Sin[t], 0}, {Sin[t], Cos[t], 0}, {0, 0, 1}};
n = 6; t2 = Pi/5;
t1 = t2/2;
alpha = ArcCos[-Sqrt[5.0]/5];
dz = Sin[t1]^2 Tan[alpha/2];
z = GoldenRatio Tan[alpha/2]/2 + dz;
scale = (Cos[t1] - Sqrt[3.0 (1 - Cos[t2])/2])/(2 Cos[t2] - 1);
R = scale Rz[ArcCos[Cos[t1] + dz^2 (scale - 1)^2/(2 scale)]];
verts = {};
verts0 = Table[{Cos[i t2], Sin[i t2], (2 Mod[i, 2] - 1) dz}, {i, 0, 
    9}];
Do[verts = Join[verts, Map[{0, 0, z} + # &, verts0]]; 
  verts0 = Map[R.# &, verts0], {n + 1}];
faces = Flatten[
   Table[10 i + {{j, Mod[j, 10] + 1, j + 10}, {j + 1, j + 10, 
       Mod[j + 10, 20] + 1}}, {i, 0, n - 1}, {j, 1, 10}], 2];
ToPolys[verts_, faces_] := Map[Polygon[verts[[#]]] &, faces];
Show[Graphics3D[{ToPolys[verts, faces], 
   Table[{ToPolys[Map[Rz[t + t2].Ry[Pi - alpha].# &, verts], faces], 
     ToPolys[Map[Rz[t].Ry[alpha].Rz[t2].# &, verts], faces]}, {t, 
     2 t2, 2 Pi, 2 t2}], ToPolys[Map[Ry[Pi].# &, verts], faces]}]]