2D Intersection of (1,1,1) plane with unit cell and nearest neighbors: TriVerts = Sqrt[3] {Sin[2 Pi #/3], Cos[2 Pi #/3]} & /@ Range[3]; poly[time_, or_] := Switch[{time >= 1/3, time <= -1/3}, {True, _}, Polygon[or + # & /@ (TriVerts (1 - time))], {_, True}, Polygon[or + # {1, -1} & /@ (TriVerts (time + 1))], {_, _}, Polygon[{}]] G[t_] := Graphics[{EdgeForm[Thick], {ColorData["TemperatureMap"][t/2], poly[1/3 + (2/3) t, {0, 0}], poly[1/3 + (2/3) t, {2, 0}], poly[1/3 + (2/3) t, {1, Sqrt[3]}]}, {ColorData["TemperatureMap"][1/2 + t/2], poly[-1 + (2/3) t, {1, -Sqrt[3]/3}], poly[-1 + (2/3) t, {2, 2 Sqrt[3]/3}], poly[-1 + (2/3) t, {0, 2 Sqrt[3]/3}]}, ColorData["TemperatureMap"][1 - t], Polygon[{ poly[1/3 + (2/3) t, {0, 0}][[1, 1]], poly[1/3 + (2/3) t, {0, 0}][[1, 3]], poly[1/3 + (2/3) t, {1, Sqrt[3]}][[1, 2]], poly[1/3 + (2/3) t, {1, Sqrt[3]}][[1, 1]], poly[1/3 + (2/3) t, {2, 0}][[1, 3]], poly[1/3 + (2/3) t, {2, 0}][[1, 2]]}]}, PlotRange -> {{-2, 4}, {-2, 3}}] ListAnimate[G[#/100] & /@ Range[0, 100]] On Wed, Jul 31, 2019 at 7:11 AM James Propp <jamespropp@gmail.com> wrote:
Can anyone dash off such a video?