4
$\begingroup$

I'm doing a visual graphing project in Mathematica and am building a rose. I've made most of it by slicing different regions of rotation using RegionFunction->[{x,y,z},x^2+y^2<4}]. Instead of using a cylinder, I know want to use different cylinder that would be created when I parametrize: ParametricPlot3D[{(1 + 1/10 Sin[20 t]^2) Cos[t], (1 + 1/10 Sin[20 t]^2) Sin[t], z}, {t, 0, 2 Pi}, {z, -2, 2}]

I want to use this perforated cylinder as a RegionFunction/ to cut out a region of the curve RevolutionPlot3D[x = 6 (Sin[y^2*1/3 + 1])*1/5, {y, 0, 2.3}, Mesh -> None, RevolutionAxis -> {1, 0, 0}]

How do I go about doing this with a parametric equation? I've tried ParametricRegion and RegionFunction, but nether are working. Any ideas would be much appreciated!

Thank you thank you!

$\endgroup$

1 Answer 1

2
$\begingroup$

It seems no general way to draw the intersection of two parametric surfaces.

Method-1

  • At first we re-write the cylinder equation to the parametric form.
Clear[plot1, plot2]; 
plot1 = 
 ParametricPlot3D[{x, (6 (Sin[x^2*1/3 + 1])*1/5)*
    Cos[s], (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s]}, {x, -2.3, 2.3}, {s, 0,
    2 π}, PlotStyle -> {Opacity[.8], Red}, Mesh -> None];
plot2 = ParametricPlot3D[{(1 + 1/10 Sin[20 t]^2) Cos[
      t], (1 + 1/10 Sin[20 t]^2) Sin[t], z}, {t, 0, 2 Pi}, {z, -2, 2},
    PlotPoints -> 50, MaxRecursion -> 4, Boxed -> False, 
   Axes -> False, Mesh -> None, PlotStyle -> Blue];
Show[plot1, plot2]

enter image description here

  • After that we solve the equation to calculate the intersection.
Clear[x, y, z1, z2, sol];
x = (1 + 1/10 Sin[20 t]^2) Cos[t];
y = (1 + 1/10 Sin[20 t]^2) Sin[t];
sol = Solve[(6 (Sin[x^2*1/3 + 1])*1/5)*Cos[s] == y, s];
z1 = (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s] /. sol[[1]] // Simplify;
z2 = (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s] /. sol[[2]] // Simplify;
curve = ParametricPlot3D[{{x, y, z1 /. C[1] -> 0}, {x, y, 
     z2 /. C[1] -> 0}}, {t, 0, 2 π}, PlotStyle -> {Blue, Blue}, 
   PlotRange -> All, PlotPoints -> 80, MaxRecursion -> 4, 
   Boxed -> False, Axes -> False, ViewProjection -> "Orthographic"];
Show[curve, plot1, ViewPoint -> #] & /@ {Above, Front, {1, 1, 1}}

enter image description here

Method-2 : Clip the surface by polar region.

Clear[plot, reg, member];
 plot = 
 ParametricPlot[{(1 + 1/10 Sin[20 t]^2) Cos[
     t], (1 + 1/10 Sin[20 t]^2) Sin[t]}, {t, 0, 2 Pi}, 
  PlotPoints -> 200, MaxRecursion -> 4];
reg = BoundaryDiscretizeGraphics[plot, MaxCellMeasure -> .001, 
   AccuracyGoal -> 3];
member = 
 RegionMember[reg]; 
ParametricPlot3D[{x, (6 (Sin[x^2*1/3 + 1])*1/5)*
   Cos[s], (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s]}, {x, -2.3, 2.3}, {s, 0, 
  2 π}, PlotPoints -> 200, MaxRecursion -> 6, Mesh -> Automatic, 
 MeshStyle -> White, 
 RegionFunction -> Function[{x, y}, member@{x, y}], PlotStyle -> Red, 
 Boxed -> False, Axes -> False, 
 BoundaryStyle -> Directive[AbsoluteThickness[4], Blue]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Wow this is so beautiful! Thank you! $\endgroup$
    – Jules Coe
    Aug 1 at 0:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.