Unrolling a surface
A general approach using Graphics3D[]
and surf[]
(below, built with NDSolve
):
rr[t_] := {Cos[t], Sin[t]};
ht[t_] := 2 + Cos[t];
Manipulate[
Graphics3D[{EdgeForm[],
surf[traj[rr, {0 &, ht}, {t, 0, 2 Pi}, 2 Pi - t0]]},
BoxRatios -> Automatic,
PlotRange -> {{-1.55 Pi, 2.05 Pi}, {-1.55 Pi, 2.05 Pi}, {-0.1, 3.5}}],
{t0, 0., 2 Pi}]
A fancier base curve:
rr[t_] := (6 + Sin[5 t]) {Cos[t], Sin[t]};
ht[t_] := 26 + 2 Cos[5 t];
dp[t_] := -26 + 3 Sin[4 t];
Manipulate[
Graphics3D[{EdgeForm[],
surf[traj[rr, {dp, ht}, {t, 0, 2 Pi}, 2 Pi - t0]]},
BoxRatios -> Automatic, PlotRange -> 40],
{t0, 0., 2 Pi}]
Utilities
ClearAll[traj, surf];
traj[r_, {a_, b_}, {t_, t1_, t2_}, t0_?NumericQ] :=
Module[{x, bottom, top},
NDSolveValue[{
x'[t] == Piecewise[
{{r'[t], t <= t0}},
Norm[r'[t]] Normalize[r'[t0]]]
, x[t1] == r[t1]
, bottom'[t] == a'[t], bottom[t1] == a[t1]
, top'[t] == b'[t], top[t1] == b[t1]},
{x, bottom, top}, {t, t1, t2}, MaxStepFraction -> 1/200]
];
surf[{curve_InterpolatingFunction, bottom_, top_}] := Module[{tgrid},
tgrid = curve@ "Grid";
GraphicsComplex[
Join[
PadRight[curve@ "ValuesOnGrid", {Automatic, 3}, bottom@tgrid],
PadRight[curve@ "ValuesOnGrid", {Automatic, 3}, top@tgrid]],
{Polygon@Flatten[
Partition[
{Range@Length@tgrid,
Range[Length@tgrid + 1, 2 Length@tgrid]},
{2, 2}, {1, 1}
],
{{1, 2}, {3, 4}}][[All, {1, 2, 4, 3}]]
},
VertexNormals -> PadRight[
Cross /@ (-curve'["ValuesOnGrid"]), {Automatic, 3},
ConstantArray[{0.}, Length@tgrid]
]
]
];
If you'd like to convert your 2D unrolling a circle process to 3D, you could do the following:
Manipulate[
ParametricPlot3D[
If[ϕ < θ, {ϕ + Sin[θ - ϕ],
1 - Cos[θ - ϕ], z (2 + Cos[θ])}, {θ, 0,
z (2 + Cos[θ])}], {θ, 0, 2 π}, {z, 0, 1},
PlotRange -> {{-1, 7}, {-1, 2}},
PlotStyle -> Directive[Opacity[0.5], Blue], Mesh -> {101, 2},
MeshFunctions -> {#4 &, #5 &}, MeshStyle -> {Black},
PlotStyle -> Thick, Axes -> False, Boxed -> False,
Exclusions -> None, ImageSize -> Large,
ViewPoint -> {0.07407987772202901`, -1.8587759603626057`,
2.8265640096935294`},
ViewVertical -> {-0.04416821572888137`, 0.374864944362155`,
0.9260266962715953`}], {ϕ, 0, 2 Pi}]
SetOptions[ParametricPlot3D, Boxed -> False, Axes -> None,
ImageSize -> Large, PlotStyle -> Directive[Opacity[0.5], Blue],
PlotRange -> {{-8, 8}, {-8, 8}, {0, 5}},
ViewProjection -> "Orthographic"];
r[s_] = {Cos[s], Sin[s]};
f[θ_, s_] :=
If[0 <= θ <= s, r[θ],
r[s] + (θ - s)*Normalize[r'[s]]];
h[θ_] = 2 + Cos[θ];
Manipulate[
ParametricPlot3D[
Append[0]@f[θ, s] + {0, 0, z*h[θ + π]}, {θ,
0, 2 π}, {z, 0, 1}, MeshFunctions -> {#4 &, #5 &},
Mesh -> {30, 2}, PerformanceGoal -> "Quality"], {s, 0, 2 π},
ControlPlacement -> Top]
We use involute curve of circle.
r[s_] := {Cos[s], Sin[s]};
f[θ_, s_] :=If[0 <= θ <= s, r[θ], r[s] + (θ - s)*Normalize[r'[s]]];
Manipulate[
ParametricPlot[f[θ, s], {θ, 0, 2 π},
PlotRange -> 5], {s, 0, 2 π}]
Or
r[s_] := {Cos[s], Sin[s]};
involute[s_] := r[s] + (2 π - s)*Normalize[r'[s]];
Manipulate[
Graphics[{Circle[], Thick, Red, Circle[{0, 0}, 1, {0, s}], Thin,
Line[{r[s], involute[s]}]}, PlotRange -> 6], {s, 0, 2 π},
ControlPlacement -> Top]