As much as I enjoy and admire Mathematica's animation capabilities, I would like to take my animations to the next level by exporting the geometry of every frame to an external ray tracing program (say POV-Ray). Is there any easy way to do such a thing, i.e., without having to manipulate hundreds, or even thousands, of individual POV-Ray files? If so, what would the workflow look like for an animation project?
Thanks for reading!
P.S. As an example of the things I'm interested in, here's some code for a project I've been doing. It depicts a plane falling into a cone, together with the resulting hyperbola.
Clear["Global`*"];
x1[t_] := -((16*(290 - 15*Sqrt[29]*Cosh[t] + 2*Sqrt[3103]*Sinh[t]))/3103)
y1[t_] := (16*(-116 + 6*Sqrt[29]*Cosh[t] + 5*Sqrt[3103]*Sinh[t]))/3103
z1[t_] := 5*x1[t] + 2*y1[t] + 8
x2[t_] := -((16*(290 + 15*Sqrt[29]*Cosh[t] + 2*Sqrt[3103]*Sinh[t]))/3103)
y2[t_] := (16*(-116 - 6*Sqrt[29]*Cosh[t] + 5*Sqrt[3103]*Sinh[t]))/3103
z2[t_] := 5*x2[t] + 2*y2[t] + 8
boven1 = Flatten[{{x, y} /. Solve[{(9/4)*(x^2 + y^2) == 21^2, 5*x + 2*y + 8 == 21}, {x, y}][[1]], 21}];
boven2 = Flatten[{{x, y} /. Solve[{(9/4)*(x^2 + y^2) == 21^2, 5*x + 2*y + 8 == 21}, {x, y}][[2]], 21}];
m1 = (boven1 + boven2)/2;
onder1 = Flatten[{{x, y} /. Solve[{(9/4)*(x^2 + y^2) == 21^2, 5*x + 2*y + 8 == -21}, {x, y}][[1]], -21}];
onder2 = Flatten[{{x, y} /. Solve[{(9/4)*(x^2 + y^2) == 21^2, 5*x + 2*y + 8 == -21}, {x, y}][[2]], -21}];
m2 = (onder1 + onder2)/2;
distance[{start_, end_}, pt_] := Module[{param}, param = (pt - start) . (end - start)/Norm[end - start]^2; Which[param < 0, EuclideanDistance[start, pt], param > 1,
EuclideanDistance[end, pt], True, EuclideanDistance[pt, start + param*(end - start)]]];
Export["hyperbola.mov", Table[Show[
Graphics3D[{Opacity[.4], RGBColor[1, 1, 1], Specularity[White, 100],
Sphere[{0, 0, 1.95}, 1.08]}, Boxed -> False],
Graphics3D[{Opacity[.4], RGBColor[1, 1, 1], Specularity[White, 100],
Sphere[{0, 0, -3.95}, 2.18]}, Boxed -> False],
ParametricPlot3D[{x1[t], y1[t], z1[t]}, {t, -1.82306, 1.82306},
RegionFunction -> Function[{x, y, z}, z >= 7 - u], PlotStyle -> {Yellow},
Method -> {"TubePoints" -> 1}] /.
Line[pts_, rest___] :> Tube[pts, 0.08, rest],
ParametricPlot3D[{x2[t], y2[t], z2[t]}, {t, -1.61735, 1.61735},
RegionFunction -> Function[{x, y, z}, z >= 7 - u], PlotStyle -> {Yellow},
Method -> {"TubePoints" -> 1}] /.
Line[pts_, rest___] :> Tube[pts, 0.08, rest],
ParametricPlot3D[{0.895 Cos[t], 0.895 Sin[t], 1.342}, {t, 0, 2 Pi},
Boxed -> False, Axes -> False, PlotStyle -> {Yellow},
Method -> {"TubePoints" -> 2}] /.
Line[pts_, rest___] :> Tube[pts, 0.02, rest],
ParametricPlot3D[{1.86 Cos[t], 1.86 Sin[t], -2.79}, {t, 0, 2 Pi},
Boxed -> False, Axes -> False, PlotStyle -> {Yellow},
Method -> {"TubePoints" -> 2}] /.
Line[pts_, rest___] :> Tube[pts, 0.02, rest],
Plot3D[5 x + 2 y + 8, {x, -9, 9}, {y, -9, 9},
RegionFunction ->
Function[{x, y, z},
z <= 21.1 - u && z >= 6.9 - u && distance[{m1, m2}, {x, y, z}] <= 6],
PlotStyle ->
Directive[Opacity[.55], Specularity[White, 100], RGBColor[1, 0, 0]],
BoundaryStyle -> {Thickness[0.003], Yellow}, Mesh -> False, Boxed -> False,
Axes -> False, PlotPoints -> 200],
Graphics3D[{Opacity[.6], Specularity[White, 200], RGBColor[0, 0, 1/2],
EdgeForm[{Thickness[0.003], Yellow}],
Cone[{{0, 0, -7}, {0, 0, 0}}, 4*7/6]}, Boxed -> False],
Graphics3D[{Opacity[.6], Specularity[White, 200], RGBColor[0, 0, 1/2],
EdgeForm[{Thickness[0.003], Yellow}],
Cone[{{0, 0, 7}, {0, 0, 0}}, 4*7/6]}], ImageSize -> {2000, 2000},
Lighting -> {{"Point", White, {10, 0, 0}}, {"Point",
White, {-10, 0, 0}}, {"Point", White, {0, 0, 0}}, {"Point",
White, {0, 0, 10}}, {"Point", White, {0, 0, -10}}}, Background -> Black,
ViewVector -> {{20 Sin[1.15 Pi + u], 20 Cos[1.15 Pi + u], 10}, {0, 0, 0}},
ViewAngle -> 50 \[Degree]], {u, -3, 14, .05}]]