Imagine picking an object and examining it by rotating it in your hand. For a random object with asymmetric shape and details the path of rotation will probably be also quite random. That is what I’d like to recreate in a simplest possible way -- a simulation of such “examination” on a screen for arbitrary 3D objects.
Let’s start with an option of fixing a random configuration we like with SeedRandom and pick a few random point on a sphere of radius 2. We will sort these points with FindShortestTour.
SeedRandom[2];​​p=FindShortestTour[RandomPoint[s=Sphere[{0,0,0},2],11]->"Elements",PerformanceGoal->"Quality"];
Using BSplineCurve we can draw a smooth closed random curve that lies almost on the sphere surface:
Graphics3D[{​​{Opacity[.2],s},​​{PointSize[.02],Red,Point[p]},​​{Dashed,Thickness[.005],BSplineCurve[p,SplineClosed->True]}​​},SphericalRegion->True,Boxed->False]
Out[]=
Using BSplineFunction allows to span the curve via a single parametric variable:
In[]:=
bsf=BSplineFunction[p,SplineClosed->True]
Out[]=
BSplineFunction
Argument count: 1
Output dimension: 3

Below we make ViewPoint to be at the curve that is spanned in a single cycle with variable t from 0 to 1. The object is FigureEight knot. We also taking advantage of Method->{“ShrinkWrap” -> True} for the object to occupy the full 3D graphics view. By running the slider we turn the camera along the curve path on the sphere, but the visible effect is the random “rotation of the object”:
In[]:=
Manipulate[​​Graphics3D[{KnotData["FigureEight","ImageData"]},​​ViewPoint->bsf[t],Method->{"ShrinkWrap"->True},​​Boxed->False,Background->RGBColor["#222831"],ImageSize->500{1,1}]​​,{t,0,1},SaveDefinitions->True]
Out[]=
​
t
Lets now add some 3D options for beautiful effects:
In[]:=
fig8knot=Graphics3D[{MaterialShading[{"Glazed",Red}],KnotData["FigureEight","ImageData"]},Lighting->"ThreePoint",Boxed->False,Background->RGBColor["#222831"],ImageSize->500{1,1},ViewPoint->bsf[0],Method->{"ShrinkWrap"->True}]
Out[]=
We know what to use now in Tour3DVideo for “CameraPosition” option (note also the timing and DefaultDuration option)
v=Parallelize@Tour3DVideo[fig8knot,<|"CameraPosition"->bsf[#/10]|>&,RasterSize->500{1,1},DefaultDuration->10];
Finally lets put some padding around video frames so it does not feel like object edges push on the canvas / background edges:
ImagePad[v,20,RGBColor["#222831"]]
Out[]=

CITE THIS NOTEBOOK

Simulating random hand-twirling for 3D digital objects with spherical splines​
by Vitaliy Kaurov​
Wolfram Community, STAFF PICKS, September 18, 2024
​https://community.wolfram.com/groups/-/m/t/3276392