正24胞体 (cells) を, 「u軸方向にd平行移動だけ」して見る.
(snake の様な cellの繋がりが見えるように展開する.)

Manipulate[
Cells1=translate[cells,d];
Polys:=Map[octahedron[proj[3,#]]&,Cells1];
Segs:=Map[skeleton[proj[3,#]]&,Cells1];
(*show*)
all:=If[filled,Polys,Segs];
If[
cellnum≥2&&adjacent&&(display=="連続"),
Graphics3D[{Opacity[1],all,Polys[[myorder[[cellnum]]]],LightGray,Opacity[0.1],Polys[[myorder[[cellnum-1]]]]},Axes->False, Boxed->False],
If[display=="連続",
Graphics3D[{Opacity[1],all,Polys[[myorder[[cellnum]]]]},Axes->False, Boxed->False]
,
Graphics3D[{Opacity[1],all,Polys[[Position[names,cellname][[1]]]]},Axes->False, Boxed->False]]
],
(*control*)
{{d,5/3},1.1,10},Delimiter,
{{filled,False,"表面表示"},{True,False}},Delimiter,
{{display,"連続","胞の選択"},{"連続","名前"}},Delimiter,
{{adjacent,True,"隣接表示"},{True,False}},
{{cellnum,1,"胞の順序"},1,24,1},Delimiter,
{{cellname,"u=-1","超平面名"},{"x+y+z+u=2","x+y+z-u=2","x+y-z+u=2","x+y-z-u=2",
"x-y+z+u=2","x-y+z-u=2","x-y-z+u=2","x-y-z-u=2",
"-x+y+z+u=2","-x+y+z-u=2","-x+y-z+u=2","-x+y-z-u=2",
"-x-y+z+u=2","-x-y+z-u=2","-x-y-z+u=2","-x-y-z-u=2"
,"x=1","y=1","z=1","u=1","x=-1","y=-1","z=-1","u=-1"}},Delimiter,
Dynamic[If[display=="連続",Graphics[{Text[
Style[names[[myorder[[cellnum]]]] ,{17,Bold}],{0,-0.2}
],Text[Style["胞の載っている超平面は,", {13}],{0,0}]}
],Graphics[{Text[
Style[cellname ,{17,Bold}],{0,-0.2}
],Text[Style["胞の載っている超平面は,",{13}],{0,0}]}
]]
],ControlPlacement->Left
,Initialization:>(
cellA[x_List]:=(
mixed:=Partition[Riffle[x,{0,0,0,0}],2];
combi={{1,1,2,2},{2,2,1,1},{1,2,1,2},{2,1,2,1},{1,2,2,1},{2,1,1,2}};
Table[Table[mixed[[i,combi[[k,i]]]],{i,1,4}],{k,1,6}]);
cellB[x_List]:=(pos:=Position[x,0];
Flatten[Table[{ReplacePart[x,k->1],ReplacePart[x,k->-1]},{k,pos}],1]);

c1111=cellA[{1,1,1,1}];c1112=cellA[{1,1,1,-1}];c1121=cellA[{1,1,-1,1}];
c1122=cellA[{1,1,-1,-1}];c1211=cellA[{1,-1,1,1}];c1212=cellA[{1,-1,1,-1}];
c1221=cellA[{1,-1,-1,1}];c1222=cellA[{1,-1,-1,-1}];c2111=cellA[{-1,1,1,1}];
c2112=cellA[{-1,1,1,-1}];c2121=cellA[{-1,1,-1,1}];c2122=cellA[{-1,1,-1,-1}];
c2211=cellA[{-1,-1,1,1}];c2212=cellA[{-1,-1,1,-1}];c2221=cellA[{-1,-1,-1,1}];
c2222=cellA[{-1,-1,-1,-1}];
cX1=cellB[{1,0,0,0}];cY1=cellB[{0,1,0,0}];cZ1=cellB[{0,0,1,0}];cU1=cellB[{0,0,0,1}];cX2=cellB[{-1,0,0,0}];cY2=cellB[{0,-1,0,0}];cZ2=cellB[{0,0,-1,0}];cU2=cellB[{0,0,0,-1}];
cells={c1111,c1112,c1121,c1122,c1211,c1212,c1221,c1222,
c2111,c2112,c2121,c2122,c2211,c2212,c2221,c2222,cX1,cY1,cZ1,cU1,cX2,cY2,cZ2,cU2};
mycells0={cU2};
cells0=Complement[cells,mycells0];


While[Length[cells]>0,
Catch[
mycells=mycells0;
cells=cells0;
Do[(
nextset=Select[cells,Length[Intersection[Last[mycells],#]]==3&];
If[nextset=={},Throw["sippai"]];
next=RandomChoice[nextset];
(*next=mysort[Last[mycells],next0];*)
AppendTo[mycells,next];
cells=Complement[cells,{next}];)
,{24}]
]
]

cells={c1111,c1112,c1121,c1122,c1211,c1212,c1221,c1222,
c2111,c2112,c2121,c2122,c2211,c2212,c2221,c2222,cX1,cY1,cZ1,cU1,cX2,cY2,cZ2,cU2};
myorder:=Map[Position[cells,#]&,mycells]//Flatten;(*myorder は cells に於ける mycells の順序.例えば,  
{24,8,7,20,9,10,21,11,3,4,17,2,1,19,6,14,16,22,5,13,15,23,12,18}*)
pts={{1,0,0},{-1,0,0},{0,1,0},{0,-1,0},{0,0,1},{0,0,-1}};
cells={c1111,c1112,c1121,c1122,c1211,c1212,c1221,c1222,
c2111,c2112,c2121,c2122,c2211,c2212,c2221,c2222,cX1,cY1,cZ1,cU1,cX2,cY2,cZ2,cU2};

translate[x_List,d_]:=Map[#+{0,0,0,d}&,x,{2}];

proj[mode_Integer,x_List]:=Switch[mode,
1,Table[Drop[x[[k]],{4}],{k,1,Length[x]}],
2,Table[Drop[x[[k]],{3}],{k,1,Length[x]}],
3,Table[1/(x[[k,4]]) Drop[x[[k]],{4}],{k,1,Length[x]}]
];

octahedron[vecs_]:=(pvecs:=Partition[vecs,2];
Table[Table[Table[Polygon[{pvecs[[1,i]],pvecs[[2,j]],pvecs[[3,k]]}],{k,1,2}],{j,1,2}],{i,1,2}]);

skeleton[vecs_]:={Line[Part[vecs,{1,3,2,4,1}]],Line[Part[vecs,{3,5,4,6,3}]],Line[Part[vecs,{1,5,2,6,1}]]};

names={
"x+y+z+u=2","x+y+z-u=2","x+y-z+u=2","x+y-z-u=2",
"x-y+z+u=2","x-y+z-u=2","x-y-z+u=2","x-y-z-u=2",
"-x+y+z+u=2","-x+y+z-u=2","-x+y-z+u=2","-x+y-z-u=2",
"-x-y+z+u=2","-x-y+z-u=2","-x-y-z+u=2","-x-y-z-u=2"
,"x=1","y=1","z=1","u=1","x=-1","y=-1","z=-1","u=-1"};


)
]