Transitions

I have long been fascinated by the family of shapes you get when you look at the intersection of a polyhedron or polytope with a (hyper)plane. I think what's most interesting to me is the challenge of trying to use the cross sections to try to mentally reconstruct the entire original shape. Of course, you can check your answer with polyhedron slices, but this really gets interesting as a tool for visualizing higher-dimensional polytopes (or, for that matter, other shapes).

In any case, after writing a bunch of ad hoc code for slicing particular shapes, I finally decided to write a general function which could produce slices of arbitrary convex polytopes of any dimension. As you can see, I'm basically just taking advantage of the ConvexHullMesh function:

slices[edges_, vec_, plotrange_] := 
 Module[{projector, pedges, n, times, positions, v},
   projector = Orthogonalize[NullSpace[{vec}]];
   pedges[t_] := (1 - t) #[[1]] + t #[[2]] & /@ edges;
   n = Length[pedges[.5]];
   times = 
    Table[NSolve[{pedges[t][[i]].vec == #, 0 <= t <= 1}, t], {i, 1, 
      n}];
   positions = Flatten[Position[times, a_ /; a != {}, 1]];
   v = Table[
     pedges[t][[positions[[i]]]] /. 
      Flatten[times[[positions[[i]]]], 1], {i, 1, 
      Length[positions]}];
   ConvexHullMesh[projector.# & /@ v, PlotRange -> plotrange, 
    PlotTheme -> "Polygons"]
   ] &

And here's the code for generating the slices of the rhombic icosahedron in the above GIF (notice that I don't start at the bottom and cut things off before getting to the top; past the cutoff points, you just have a linearly growing or shrinking pentagon, which is kind of boring):

DynamicModule[{polyhedron, sliceaxis, plotrange, cols, 
  edges, θ},
 polyhedron = "RhombicIcosahedron";
 sliceaxis = {0, 0, 1};
 plotrange = 2;
 cols = RGBColor /@ {"#04D976", "#0f2532"};
 edges = PolyhedronData[polyhedron, "VertexCoordinates"][[#]] & /@ 
   PolyhedronData[polyhedron, "Edges"][[2, 1]];
 Manipulate[θ = 3/(2 Sqrt[5]) Cos[s]; 
  Graphics[{FaceForm[None], 
    EdgeForm[
     Directive[JoinForm["Round"], cols[[1]], Thickness[.005]]], 
    GraphicsComplex[MeshCoordinates[#], MeshCells[#, 2]] &[
     slices[edges, sliceaxis, plotrange][θ]]}, 
   PlotRange -> plotrange, ImageSize -> 540, 
   Background -> cols[[2]]], {s, 0, π}]
 ]