6
$\begingroup$

Let ABCD be a square with AB=2. Rotate the filled ABD (see picture) about AB. enter image description here

I tried

RevolutionPlot3D[1 - Sqrt[1 - t^2], {t, 0, 1}, Boxed -> False, 
 Axes -> False]

enter image description here

and

RevolutionPlot3D[1  +  Sqrt[-3 + 4 t - t^2], {t, 1, 2}, 
 Boxed -> False, Axes -> False]

enter image description here

I tried with Piecewise

pw[u_] := 
 Piecewise[{{{u, 1 - Sqrt[1 - u^2]}, 
    0 <= u <= 1}, {{u, 1  +  Sqrt[-3 + 4 u - u^2]}, 1 < u <= 2}}]

RevolutionPlot3D[{pw[u][[1]], pw[u][[2]]}, {u, 0, 2}, Boxed -> False, 
 Axes -> False]

enter image description here

How can I make an animation when using RevolutionPlot3D?

PS. Where is wrong when I use this?

RevolutionPlot3D[
 Piecewise[{{1 - Sqrt[1 - x^2], 
    0 <= x <= 1}, {1  +  Sqrt[-3 + 4  x - x^2], 1 <= x < 2}}], {x, 0, 
  2}, AxesLabel -> {"x", "y", "z"}, Mesh -> None, RevolutionAxis -> {0, 0, 1}]

enter image description here

$\endgroup$
6
  • $\begingroup$ You mean something like Animate[RevolutionPlot3D[1 + Sqrt[-3 + 4 t - t^2], {t, 0, tmax}, Boxed -> False, Axes -> False, PerformanceGoal -> "Quality"], {tmax, 2, 4, .01}] ? $\endgroup$
    – Nasser
    Commented Mar 25 at 0:24
  • $\begingroup$ Yes. Thank you. I want to make Animate with the function Piecewise. $\endgroup$ Commented Mar 25 at 0:26
  • $\begingroup$ How about Animate[RevolutionPlot3D[{pw[u][[1]], pw[u][[2]]}, {u, 0, tmax}, Boxed -> False, Axes -> False, PerformanceGoal -> "Quality"], {tmax, 1, 3, .01}] using the definition of your `pw. You can play with options to improve display as needed $\endgroup$
    – Nasser
    Commented Mar 25 at 0:31
  • $\begingroup$ @Nasser Thank you. Please see my edit. $\endgroup$ Commented Mar 25 at 0:38
  • 1
    $\begingroup$ Exclusions -> None. $\endgroup$
    – cvgmt
    Commented Mar 25 at 0:39

2 Answers 2

9
$\begingroup$

Edit

  • animate
  • axis is the rotation axis, we can set axis={0,0,1} or axis={1,0,0} etc.
Clear["Global`*"];
f[x_] := 
  Piecewise[{{1 - Sqrt[1 - x^2], 
     0 <= x <= 1}, {1 + Sqrt[-3 + 4      x - x^2], 1 <= x < 2}}];
plot = Plot[f[x], {x, 0, 2}, AspectRatio -> Automatic, 
   Exclusions -> None, Filling -> Top];
reg = RotationTransform[π/2, {1, 0, 0}]@
   RegionProduct[DiscretizeGraphics[plot], Point[{0.}]];
draw[t_, axis_ : {0, 0, 1}] := 
 Module[{plot1, plot2, reg2}, 
  plot1 = RevolutionPlot3D[f[x], {x, 0, 2}, {θ, 0, t}, 
    AxesLabel -> {"x", "y", "z"}, Mesh -> None, 
    RevolutionAxis -> axis, Exclusions -> None, Boxed -> False, 
    Axes -> False, PerformanceGoal -> "Quality"];
  plot2 = 
   RevolutionPlot3D[2, {x, 0, 2}, {θ, 0, t}, 
    AxesLabel -> {"x", "y", "z"}, Mesh -> None, 
    RevolutionAxis -> axis, Exclusions -> None, Boxed -> False, 
    Axes -> False, PerformanceGoal -> "Quality"];
  plot = 
   Plot[f[x], {x, 0, 2}, AspectRatio -> Automatic, Exclusions -> None,
     Filling -> Top];
  reg2 = RotationTransform[t, axis]@reg;
  Show[plot1, plot2, Graphics3D[{EdgeForm[], reg}], 
   Graphics3D[{EdgeForm[], reg2}], PlotRange -> 2, 
   BoxRatios -> Automatic, ViewPoint -> {1, 1, 1}, 
   ImageSize -> Medium]]
ani = Manipulate[
  GraphicsRow@{draw[t, {0, 0, 1}], 
    draw[t, {1, 0, 0}]}, {t, $MachineEpsilon, 2    π}]

enter image description here

Original

  • Since the original seems want to rotation a filled region, here we draw a revolution solid.
Needs["OpenCascadeLink`"]; 
pw[u_] := 
 Piecewise[{{{u, 1 - Sqrt[1 - u^2]}, 
    0 <= u <= 1}, {{u, 1 + Sqrt[-3 + 4  u - u^2]}, 1 < u <= 2}}]
plot = ParametricPlot[pw[u], {u, 0, 2}, Exclusions -> None, 
   AspectRatio -> Automatic];
pts = Cases[Normal@plot, Line[pts_] :> pts, -1][[1]];
poly2d = Join[pts, {{0, pts[[-1]] // Last}}] // Polygon;
poly3d = RegionProduct[poly2d, Point[{0}]];
shape = OpenCascadeShape[poly3d];
sweep = OpenCascadeShapeRotationalSweep[shape, {{0, 0, 0}, {0, 1, 0}},
   2 π]
bmesh = OpenCascadeShapeSurfaceMeshToBoundaryMesh[sweep, 
   "ShapeSurfaceMeshOptions" -> {"AngularDeflection" -> 0.1}];
reg = BoundaryMeshRegion[bmesh];
bmesh["Wireframe"[
  "MeshElementStyle" -> Directive[FaceForm[Cyan], EdgeForm[]], 
  Lighting -> "ThreePoint", ViewPoint -> Right, 
  ViewVertical -> {0, 1, 0}]]

enter image description here

$\endgroup$
1
  • $\begingroup$ How can I rotate ox axis? $\endgroup$ Commented Mar 25 at 2:01
2
$\begingroup$

I am not sure now why

RevolutionPlot3D[
 Piecewise[{{1 - Sqrt[1 - x^2], 
    0 <= x <= 1}, {1  +  Sqrt[-3 + 4  x - x^2], 1 <= x < 2}}], {x, 0, 
  2}, AxesLabel -> {"x", "y", "z"}, Mesh -> None, RevolutionAxis -> {0, 0, 1}]

gives

enter image description here

Until someone finds out, here is a simple workaround

p[x_?NumericQ] := Piecewise[
   {{1 - Sqrt[1 - x^2], 0 <= x < 1},
    {1 + Sqrt[-3 + 4   x - x^2], 1 <= x < 2}
    }
   ];
RevolutionPlot3D[
 p[x], {x, 0, 2},
 AxesLabel -> {"x", "y", "z"},
 Mesh -> None,
 RevolutionAxis -> {0, 0, 1}
 ]

enter image description here

To animate

p[x_?NumericQ] := 
  Piecewise[{{1 - Sqrt[1 - x^2], 
     0 <= x < 1}, {1 + Sqrt[-3 + 4    x - x^2], 1 <= x < 2}}];
Animate[
 RevolutionPlot3D[p[x], {x, 0, tmax}, AxesLabel -> {"x", "y", "z"}, 
  RevolutionAxis -> {0, 0, 1}, PerformanceGoal -> "Quality", 
  PlotRange -> {{-4, 4}, {-4, 4}, {-1, 2}}], {tmax, 1, 4, .01}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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