9

I'm trying to draw a figure as shown below and make it rotate around the vertical axis (z-axis) automatically.

Figure to be rotated

This is how I generate the figure and make it rotate:

Δϕ = π 14.0/13.0;
p1 = 
  Show[
    Table[
      RegionPlot3D[
        x^2 + y^2 + (z - j)^2 < 0.5^2 && 
        (x - 0.4 Cos[j Δϕ]) Cos[j Δϕ] + (y - 0.4 Sin[j Δϕ]) Sin[j Δϕ] < 0, 
        {x, -0.5, 0.5}, {y, -0.5, 0.5}, {z, -0.5 + j, 0.5 + j}, 
        PlotStyle -> Blue, Mesh -> None], 
      {j, 0, 5}], 
      PlotRange -> All, BoxRatios -> Automatic];
p2 = 
  Graphics3D[
    Table[
      Arrow[{{0.4 Cos[j Δϕ], 0.4 Sin[j Δϕ], j}, {Cos[j Δϕ], Sin[j Δϕ], j}}], 
      {j, 0, 5}]];
p = 
  Show[{p1, p2}, 
    Boxed -> False, Axes -> False, 
    ViewPoint -> {0, -10, 0}, ViewCenter -> {0, 0, 2.5}, 
    ViewVertical -> {0, 0, 1}];
vc = AbsoluteOptions[p, ViewCenter][[1, 2]];
vp = AbsoluteOptions[p, ViewPoint][[1, 2]];
m = RotationMatrix [5 Degree, {0., 0., 1.}];
newvp = m.(vp - vc);
Export["a.gif", 
  Table[
    Show[p, 
      ViewPoint -> MatrixPower[m, j].(vp - vc) + vc, 
      PlotRange -> All], 
    {j, 0, 360/5 - 1}]];

This is how the gif file looks like The output gif file

I don't understand why the gif is kind of oscillating in the horizontal direction, and the arrows seem turn around when a cycle is done and the next cycle starts. What I want is to have the rotating axis (here the z-axis) fixed while the figure is rotating. Which part of my code is wrong?

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
ruima86
  • 273
  • 1
  • 6
  • 5
    I believe the image is centered in each frame, but because the arrows protrude at different times, the position of the balls changes. – David G. Stork Feb 24 '16 at 23:39
  • 4
    You need to use a fixed PlotRange instead of PlotRange -> All, and maybe add a SphericalRegion -> True while you're at it. – J. M.'s missing motivation Feb 25 '16 at 00:38
  • I tried fixed PlotRange, but it didn't work. Adding SphericalRegion -> True only shows a tiny part of the figure. – ruima86 Feb 25 '16 at 01:46
  • I usually draw a white rectangle on the background that's larger than the animation region, so this remains centred. For the arrows, perhaps try with a tube, the one you are using is 2D so it has problems twice per turn. – tsuresuregusa Feb 25 '16 at 03:51
  • Regarding the flipping arrowheads, you can either use 3D arrows or try to add something along the lines Arrowheads[Medium, Appearance -> "Projected"] in your 3D expression. – Yves Klett Feb 25 '16 at 09:15
  • Possible duplicates: (2565), (3759) – Mr.Wizard Feb 27 '16 at 00:15

1 Answers1

10

Perhaps the following will work for you. Since I worked it out more by trial-and-error than by expertise, there may be unnecessary code that remains. Mainly what I did was the following:

  1. Computed the camera position before doing the export by a better method. Your computation of the camera position was the source of the oscillation.

  2. Eliminated many options, some of which caused problems and others which were simply redundant. I also added a few options the improve the look of graphics.

Δϕ = π 14.0/13.0;

p1 = Table[ RegionPlot3D[ x^2 + y^2 + (z - j)^2 < 0.5^2 && (x - 0.4 Cos[j Δϕ]) Cos[j Δϕ] + (y - 0.4 Sin[j Δϕ]) Sin[j Δϕ] < 0, {x, -0.5, 0.5}, {y, -0.5, 0.5}, {z, -0.5 + j, 0.5 + j}, PlotStyle -> Blue, Lighting -> "Neutral", Mesh -> None], {j, 0, 5}];

p2 = Graphics3D[{ Black, Table[ Arrow @ Tube[{{0.4 Cos[j Δϕ], 0.4 Sin[j Δϕ], j}, {Cos[j Δϕ], Sin[j Δϕ], j}}], {j, 0, 5}]}];

vp = Table[ RotationTransform[θ, {0, 0, 1}, {0, 0, 0}][{0, -50, 3}], {θ, N[2 π Subdivide[36]]}];

Export[ FileNameJoin[{$HomeDirectory, "Desktop", "RotatingSpheres.gif"}], Show[p1, p2, PlotRange -> {{-1, 1}, {-1, 1}, {-.5, 5.5}}, Axes -> False, Boxed -> False, BoxRatios -> Automatic, SphericalRegion -> True, ViewPoint -> #] & /@ vp];

gif

Update

At Yves Klett's behest, I have made the arrows into 3D tube-based arrows.

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
  • you are really fast... love the use of vp to vectorise the command. – tsuresuregusa Feb 25 '16 at 04:13
  • 1
    Perhaps the use of 3D arrow primitives would be useful to avoid the arrowheads spinning. – Yves Klett Feb 25 '16 at 06:19
  • @YvesKlett. I agree. I didn't work on that part of problem. I think there already answers on the site that describe how to 3D primitives to make better 3D arrows. – m_goldberg Feb 25 '16 at 07:21
  • @m_goldberg it would be as simple as replacing Arrow by Arrow@Tube here: Arrow@Tube[{{0.4 Cos... (perhaps adding some Black on the way, too). – Yves Klett Feb 25 '16 at 07:26
  • 2
    @YvesKlett. OK, I did it. I admit I was just being lazy. – m_goldberg Feb 25 '16 at 08:00
  • 1
    nice! There is also Arrowheads[Medium, Appearance -> "Projected"] for 2D arrowheads (I just put this here as a reminder). – Yves Klett Feb 25 '16 at 09:17
  • Thank you very much. I think the problem also comes from the fact that I combine p1 and p2 into p. I tried show[p1,p2,...] instead of Show[p, ...] and get what I wanted. – ruima86 Feb 25 '16 at 14:48