3
$\begingroup$

We have taken measurements on a cylindrical flexible item. At each of the measurement locations we have an oscillating motion which is described in terms of three orthogonal directions. The measurement locations are as follows.

loc = {{0., -0.38, 0.45}, {0.38, 0., 0.45}, {0., 0.38, 0.45}, {-0.38, 
    0., 0.45}, {0., -0.38, 0.}, {0.38, 0., 0.}, {0., 0.38, 
    0.}, {-0.38, 0., 0.}, {0., 0., 0.}};
Graphics3D[{
  CapForm["Butt"], Tube[{{0, 0, 0}, {0, 0, 0.450}}, 0.445],
  PointSize[0.05], Point[loc],
  Red, Table[
   Text[Style[ToString[n], FontSize -> 20], loc[[n]], {2, 2}], {n, 
    Length@loc}]
  }, Boxed -> False]

Mathematica graphics

We have very few points but would like to interpolate a surface through them and then animate it. To just animate the points we start with the amplitude in each direction.

amps = {{2.1172594021473907`, 0.5278129873372176`, 
    0.6357924201629053`}, {0.5283983516606015`, -2.117645776531968`, \
-0.6361650734151563`}, {-2.117268206573674`, -0.5281184546243277`, 
    0.6360449235672346`}, {-0.5283408275109929`, 
    2.1178550960586198`, -0.6364350160921678`}, {-2.11767393568768`, \
-0.5280766141966133`, 0.6359387078939539`}, {-0.5283396667175511`, 
    2.1176290476331916`, -0.6363014582924607`}, {2.1174152124503625`, 
    0.5278351253986322`, 
    0.63601206166253`}, {0.528691753834085`, -2.117390889873449`, \
-0.6362719888227266`}, {0.00011824352907719739`, 
    0.00029548793265142455`, 0.000046835711279249544`}};

A factor sf is introduced to scale the amplitude and we can animate.

sf = 0.05;
Animate[
 Graphics3D[{
   Table[Point[loc[[n]] + sf Re[E^(I t) amps[[n]]]], {n, Length@loc}]
   },
  PlotRange -> {{-0.600, 0.600}, {-0.600, 0.600}, {-0.200, 0.600}},
  Axes -> True, AxesLabel -> {"x", "y", "z"}],
 {t, 0, 2 \[Pi]}
 ]

Mathematica graphics

We know that ListPlot3D can interpolate a surface and we can do this for one side in one direction as follows.

loc1 = loc[[{5, 6, 7, 8, 9}]];
amps1 = amps[[All, 3]][[{5, 6, 7, 8, 9}]];
sf = 0.1;
Animate[
 Show[
  ListPlot3D[
   Table[loc1[[n]] + sf Re[E^(I t) amps1[[n]]], {n, Length@loc1}],
   PlotRange -> {{-0.600, 0.600}, {-0.600, 0.600}, {-0.2, 0.2}}],
  Graphics3D[{
    PointSize[0.02], Red, 
    Point@Table[
      loc1[[n]] + sf Re[E^(I t) amps1[[n]]], {n, Length@loc1}]
    }]
  ],
 {t, 0, 2 \[Pi]}
 ]

Mathematica graphics

(On a minor observation why does the interpolation not always include the point?). However we have three directions at each location and we need to animate each direction at the same time. Somehow I feel that we should be able to set up a NURBS surface but I can't see how to do this. Any suggestions? An additional help would be to extrapolate to the circular shape. Thanks

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.