# Create surface by combining 2D curves

I'm trying to create a plot in which I look at the change of a curve as a function of a parameter.

My problem is quite complicated so below you can see a simplifying example

    Table[ParametricPlot3D[{(1 + 1/A) Cos[\[Theta]], (1 + 1/
A) Sin[\[Theta]], A}, {\[Theta], -\[Pi], \[Pi]},
BoxRatios -> {1, 1, 1},
PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}], {A, 0.5, 1, 0.1}] I wish to make from these curves a continous surface (in this case it will be a something like a cone).

In my original problem these curves are parts of solutions for and ODE so just plotting the shape I want will not solve the problem here, therefore I ask for an answer that will generically create a surface out of the combination of these curves.

Update:

Here is an out line of what I'm trying to do with the problem I'm working on:

I have a 2D dynamical system that undergoes a hopf bifurcations as the parameter A is varied.

  f[x_, y_, A_] :=
10 - 0.05 (x - 1) (1 + 1/A + 1/y Exp[(2 (x - 1))/(10 y)] )  ;
g[x_, y_, A_] := A (1 - y) - y Exp[(2 (x - 1))/(10 y)];


I solve the equations for large t to guarantee that the solution converges either to a stable fixed point or into a limit cycle

sol1 = NDSolve[{
x'[t] == f[x[t], y[t], 1], y'[t] == g[x[t], y[t], 1], x == 0.2,
y == 0.2}, {x, y}, {t, 0, 50}];
sol2 = NDSolve[{
x'[t] == f[x[t], y[t], 2], y'[t] == g[x[t], y[t], 2], x == 0.2,
y == 0.2}, {x, y}, {t, 0, 50}];
sol3 = NDSolve[{
x'[t] == f[x[t], y[t], 3], y'[t] == g[x[t], y[t], 3], x == 0.2,
y == 0.2}, {x, y}, {t, 0, 50}];
sol4 = NDSolve[{
x'[t] == f[x[t], y[t], 4], y'[t] == g[x[t], y[t], 4], x == 0.2,
y == 0.2}, {x, y}, {t, 0, 50}];


I pick the last part of the solution (the end of the time series) and plot it with a ParametricPlot3D

p1 = ParametricPlot3D[{Evaluate[x[t]], Evaluate[y[t]], 1} /. sol1, {t,
49, 50}, PlotStyle -> {Thick, Red}, PlotPoints -> 10^5,
BoxRatios -> {1, 1, 1}, PlotRange -> {{0, 10}, {0, 1}, {0, 10}}];
p2 = ParametricPlot3D[{Evaluate[x[t]], Evaluate[y[t]], 2} /. sol2, {t,
49, 50}, PlotStyle -> {Thick, Red}, PlotPoints -> 10^5,
BoxRatios -> {1, 1, 1},
PlotRange -> {{0, 10}, {0, 1}, {0, 10}}];
p3 = ParametricPlot3D[{Evaluate[x[t]], Evaluate[y[t]], 3} /. sol3, {t,
49, 50}, PlotStyle -> {Thick, Red}, PlotPoints -> 10^5,
BoxRatios -> {1, 1, 1}, PlotRange -> {{0,10}, {0, 1}, {0, 10}}];
p4 = ParametricPlot3D[{Evaluate[x[t]], Evaluate[y[t]], 4} /. sol4, {t,
49, 50}, PlotStyle -> {Thick, Red}, PlotPoints -> 10^5,
BoxRatios -> {1, 1, 1}, PlotRange -> {{0,10}, {0, 1}, {0, 10}}];


Put all of the plots together

   Show[p1, p2, p3, p4]


What I'd like to obtain is a continuous surface (small increments of A) that passes through these contours as stated in the original question.

• why not ParametricPlot3D[{(1 + 1/A) Cos[\[Theta]], (1 + 1/A) Sin[\[Theta]], A}, {\[Theta], -\[Pi], \[Pi]}, {A, 0.5, 1}, BoxRatios -> {1, 1, 1}, PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}]?
– kglr
Jun 20, 2019 at 8:52
• @kglr, in my problem for each value of 'A' I have a different solution produced by NDSolve Jun 22, 2019 at 12:22
• jarhead, have you tried ParametricNDSolveValue?
– kglr
Jun 22, 2019 at 21:16
• jarhead, what is lf?
– kglr
Jun 23, 2019 at 8:00
• @kglr, sorry it is a number, corrected, thanks. Jun 23, 2019 at 10:40

You can use two-parameter version of ParametricPlot3D to get the desired surface:

 ParametricPlot3D[{(1 + 1/A) Cos[θ], (1 + 1/A) Sin[θ], A},
{θ, -π, π}, {A, 0.5, 3},
MeshFunctions -> {#5 &},
Mesh -> {Range[ 0.5, 3, .1]},
BoundaryStyle -> None,
BoxRatios ->1,
PlotRange -> {{-5, 5}, {-5, 5}, {-5, 5}}] Alternatively, combine all plots using Show, extract line coordinates and use them with ListPlot3D:

show = Show[Table[ParametricPlot3D[{(1 + 1/A) Cos[θ], (1 + 1/A) Sin[θ], A}, {θ, -π, π},
BoxRatios -> {1, 1, 1},
PlotRange -> {{-5, 5}, {-5, 5}, {-5, 5}}, PlotPoints -> 100],
{A, 0.5, 3, 0.1}]];

pts = Join @@ Cases[show, Line[x_] :> x, {0, Infinity}];

Show[ListPlot3D[pts, Mesh -> None, ClippingStyle -> None,
PlotRange -> {-5, 2.99}], PlotRange->{-5,5}, BoxRatios->1] A slower alternative is to use ListSurfacePlot3D:

ListSurfacePlot3D[pts, Mesh -> None,
PlotRange -> {{-5, 5}, {-5, 5}, {-5, 5}}, MaxPlotPoints -> 500] • this is extremely slow Jun 22, 2019 at 12:17
• @jarhead, ListSurfacePlot3D is slow. But in the first 2, additional processing (above what you need to create lines with one-parameter ParamatricPlot3D) is not too exorbitant. It would help to post an example that reflects your real case.
– kglr
Jun 22, 2019 at 21:16
• I've added an example that reflects the real case in the question, emphasizing the steps of what I want to do. Jun 23, 2019 at 7:28