To create a random polyhedra walk, just use this function with any polyhedron in form:
GraphicsComplex[pts_,Polygon[vertices_,___]]
When I find time and motivation maybe I will add more DownValues so it can be more general.
At the moment you can play with solids given by PolyhedronData[... “Faces”]:
In[]:=
polyhedronRandomWalk[PolyhedronData["DuerersSolid","Faces"]]
{11,9,4}
{11,9,4}
{11,9,4}
{11,9,4}
It should automatically select the proper bottom face but if you want you can take any one you like:
In[]:=
polyhedronRandomWalk[PolyhedronData["DuerersSolid","Faces"],"BottomInd"->1]
{1,7,8,12,3}
{1,7,8,12,3}
{1,7,8,12,3}
{1,7,8,12,3}
You don’t have to be restricted to the movement on one plane!
In[]:=
polyhedronRandomWalk[PolyhedronData["DuerersSolid","Faces"],"PlaneMovement"->False]
{11,9,4}
{11,9,4}
{11,9,4}
{11,9,4}

Code

It can be golfed down but I wanted to leave it more descriptive form. I can add some explanations if questions arise.
In[]:=
ClearAll[polyhedronRandomWalk];​​​​Options[polyhedronRandomWalk]={"BottomInd"->Automatic,"PlaneMovement"->True};​​​​polyhedronRandomWalk[GraphicsComplex[vertices_,Polygon[indices_,___]],OptionsPattern[]]:=DynamicModule[{pts,faces,bottomface,step,t,task,traces,transformation,whichIsBottom},Panel@Grid[{{Column[{Button["Run",task=RunScheduledTask[t+=.1;​​If[t==1,pts=transformation[1]/@pts;​​step[bottomface];t=0;];,.05],ImageSize->200],Button["Stop",StopScheduledTask[task],ImageSize->200],Button["Forget",RemoveScheduledTask[task];traces={};​​t=0;,ImageSize->200]}],Graphics3D[{Opacity@.5,Dynamic@GraphicsComplex[transformation[t]/@pts,Polygon[faces]],Dynamic@traces},PlotRange->All,ImageSize->{500,500}]}},Alignment->Top],Initialization:>(pts=N@vertices;​​faces=indices;​​whichIsBottom=OptionValue["BottomInd"]/.Automatic->(Position[#,Min[#]]&[Mean[pts[[#]][[;;,3]]]&/@faces][[1,1]]);​​bottomface=faces[[whichIsBottom]];​​traces={};​​Print[bottomface];​​SetAttributes[step,HoldFirst];​​step[bottomface_]:=Module[{pivot,nextface,nn,nb,angle},traces=Join[traces,{Hue@RandomReal[],Polygon@pts[[bottomface]]}];​​pivot=RandomChoice@Partition[bottomface,2,1,{1,1},bottomface];​​nextface=Composition[First,DeleteCases[#,bottomface]&,Select[#,Count[#,Alternatives@@pivot]==2&]&]@faces;​​{nb,nn}=Function[{meanBF,meanP,pivotV,meanNF},{{meanP,meanP+#-Projection[#,pivotV-meanP]}&[meanP-meanBF],{meanP,meanP+#-Projection[#,pivotV-meanP]}&[meanNF-meanP]}][Mean@pts[[bottomface]],Mean@pts[[pivot]],pts[[First@pivot]],Mean@pts[[nextface]]];​​angle=VectorAngle@@(#2-#&@@@{nn,nb});​​bottomface=If[TrueQ@OptionValue["PlaneMovement"],nextface,Composition[First,Select[#,Length[Intersection[#,nextface]]==2&]&]@faces];​​transformation[t_]:=Evaluate@RotationTransform[anglet,Cross@@(#2-#&@@@{nn,nb}),Mean@pts[[pivot]]];];​​step[bottomface];​​t=0;)]

CITE THIS NOTEBOOK

Random polyhedra walk in 3D space​
by Kuba Podkalicki​
Wolfram Community, STAFF PICKS, September 5, 2024
​https://community.wolfram.com/groups/-/m/t/3267958