Orthoplex

Short explanation: this is a rotating 16-cell stereographically projected to three-dimensional space.

Longer explanation: start with the 16-cell in 4-space. The coordinates of the vertices are $(\pm 1,0,0,0), (0,\pm 1,0,0), (0,0,\pm 1,0), (0,0,0,\pm 1)$, which I input to Mathematica as:

sixteencellvertices = Flatten[Permutations[{-1, 0, 0, 0}]^# & /@ Range[1, 2], 1];

In the 16-cell, all vertices that are not antipodal are connected by edges (just as in the octahedron, which is the Platonic solid most analogous to the 16-cell):

sixteencelledges = Select[Subsets[sixteencellvertices, {2}], #[[1]] != -#[[2]] &];

Now, to make the animation, I projected the 16-cell to the unit sphere in 4-sphere and then stereographically projected to three-dimensional space, so we'll need a stereographic projection function:

Stereo3D[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)};

Because of some weird interaction between Tube and Lighting, the vertical tube that results looks weird. So I modified sixteencelledges to remove the edges that become vertical after stereographic projection; in the final animation I'll just add a single vertical tube:

sixteencelledgesnoverts = Delete[sixteencelledges, {#} & /@ {18, 12, 15, 24}];

Now, in order to project the edges to the unit sphere, I parametrize them and then will, in the final animation, Normalize:

sixteencellparametrizededgesnoverts[t_] := (1 - t) #[[1]] + t #[[2]] & /@ sixteencelledgesnoverts;

I'm going to apply a RotationTransform as well as Normalize and Stereo3D to each of the remaining edges, which are really just tubes around 100 points. Since there are 20 edges defined by 100 points each and there's a lot of transparency in the final animation, things get extremely slow. To speed things up a bit I encapsulate all of this in a compiled function.

StereoC = 
  Compile[{{?, _Real, 0}, {t, _Real, 0}}, #, Parallelization -> True, RuntimeAttributes -> {Listable}] 
   &[Stereo3D[ Normalize[RotationTransform[?, {{0, 0, 1, 0}, {0, 0, 0, 1}}][#]]] & /@ sixteencellparametrizededgesnoverts[t]];

Now we're finally ready to make the animation. The remaining code basically just calls StereoC and then sets the lighting, opacity, etc. Note that in the below code I have d = 1/20, which makes things a little blocky. The animation above uses d = 1/100, but this makes things way too slow for a Manipulate, so below I've changed to d = 1/20:

smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;

With[{d = 1/20, viewpoint = 5 {1, 1, 1},
  cols = RGBColor /@ {"#932B77", "#4E1184", "#0E1555"}},
 Manipulate[
  Graphics3D[
   {White, Opacity[.5], Tube[{{0, 0, -10}, {0, 0, 10}}, .15],
    Tube[#, .15] & /@ 
     Transpose[Table[StereoC[?/2 smootheststep[?] + .0001, t], {t, 0., 1, d}]]},
   PlotRange -> 8, ImageSize -> 540, Axes -> None, Boxed -> False, 
   ViewPoint -> 5 {1, 1, 1}, ViewAngle -> ?/120, 
   Background -> cols[[-1]],
   Lighting -> {{"Point", cols[[1]], {1, 0, 0}}, {"Point", cols[[1]], {-1, 0, 0}},
     {"Point", cols[[1]], {0, 1, 0}}, {"Point", cols[[1]], {0, -1, 0}},
     {"Point", cols[[2]], {0, 0, 0}}, {"Point", cols[[2]], {0, 0, -1}},
     {"Point", cols[[2]], {0, 0, 1}}, {"Ambient", cols[[-1]], 
      viewpoint}}],
  {?, 0, 1}]
 ]