7
$\begingroup$

The surface is determined by this parametric equation

ParametricPlot3D[{Cos[θ],Sin[θ],z(2+ Cos[θ])},{θ,-Pi,Pi},{z,0,1}]

enter image description here
How to unfold the surface in Mathematica? Just like this animation enter image description here

I only know how to unfold a circle

Manipulate[ParametricPlot[If[ϕ<θ,{ϕ+Sin[θ-ϕ],1-Cos[θ-ϕ]},{θ,0}],{θ,0,2π}, PlotRange->{{-1,7},{-1,2}},PlotStyle->Thick],{ϕ,0,2Pi}]

Updated

Thank you all, finally, I got two ways

f1[θ_,z_,ϕ_]:=If[ϕ<θ,{Cos[θ-ϕ],ϕ+Sin[θ-ϕ],z(2-Cos[θ])},{1,θ,z(2-Cos[θ])}]; f2[θ_,z_,ϕ_]:=If[ϕ<θ,{Cos[θ],-Sin[θ],z(2-Cos[θ])}, {(ϕ-θ) Sin[ϕ]+Cos[ϕ],(ϕ-θ) Cos[ϕ]-Sin[ϕ],z(2-Cos[θ])}]; Manipulate[ParametricPlot3D[f1[θ,z,ϕ],{θ,0,2Pi},{z,0,1}, PlotRange->{{-5,2},{-5,7},{-1,4}},PerformanceGoal->"Quality",Exclusions->None ],{ϕ,0,2Pi}]

enter image description here

Improve this question
$\endgroup$
3
  • 2
    $\begingroup$ Perhaps you could pick up a few ideas from Kuba's answer here. $\endgroup$ Commented Dec 23, 2020 at 11:45
  • $\begingroup$ Just an idea(I did it with other softwares in the past). During the unfold, calculate the arclength, and draw the curve above(In other words, draw it as two parts.) $\endgroup$ Commented Dec 23, 2020 at 13:51
  • 1
    $\begingroup$ Related: demonstrations.wolfram.com/UnwrappingInvolutes $\endgroup$ Commented Dec 23, 2020 at 23:55

4 Answers 4

Reset to default
4
$\begingroup$

enter image description here

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]

enter image description here

Improve this answer
$\endgroup$
6
$\begingroup$

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}]

enter image description here

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}]

enter image description here

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] ] ] ];
Improve this answer
$\endgroup$
3
  • $\begingroup$ I also consider another general approach which the function high=ht[] has not explicit expression. $\endgroup$ Commented Dec 28, 2020 at 23:13
  • $\begingroup$ @cvgmt Yes, quite. I didn't mean to imply anything about any other answer. I was just suggesting a reason for taking out a sledgehammer like NDSolve for the comparatively simple problem in the OP. $\endgroup$ Commented Dec 29, 2020 at 0:33
  • $\begingroup$ Yes, I am also interesting in how to use differential equation to deformat a curves or a surface. $\endgroup$ Commented Dec 29, 2020 at 0:42
4
$\begingroup$

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}]

Unrolling animation

Improve this answer
$\endgroup$
1
$\begingroup$

In a unfolded 2D plot, the base length (z==0) is simply: phi.This gives the x coordinate. And the y coordinate is given by: z(2+ Cos[phi]):

ParametricPlot[{phi, z (2 + Cos[phi])}, {phi, 0, 2 Pi}, {z, 0, 1}]

enter image description here

Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ Why is this receiving downvotes? $\endgroup$ Commented Dec 23, 2020 at 18:36

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.