7
$\begingroup$

Imagine I want the 3D plot of a solid object that has height $H$ and a circular base of radius $R$. The radius of the horizontal cross-section of the object at height $z$ above the base reduces with $z$ ($0 \leq z \leq H$) according to the formula $R_z = R e^{-z/H}$. Additionally, the cross-section is a sector of the circle: the full circle ($2\pi$ radians) at the base but reducing linearly with height to $\pi$ radians at height $z = H$. The figure shows the horizontal cross-section of the object at the base, at the mid-height, and at the top. The following is a cross-sectional scheme of what I mean, at three heights:

enter image description here

I tried to plot it by parametrizing the radius and angle, which gives me a good approximation, for $R=1$ and $H=2$,

R = 1;
H = 2; 
radius[z_] := R  Exp[-z/H]
theta[z_] := 2  Pi - (Pi  z)/H
x[r_, t_, z_] := r  Cos[t]
y[r_, t_, z_] := r  Sin[t]
zCoord[z_] := z
sideFilled = 
  ParametricPlot3D[{x[radius[z], t, z], y[radius[z], t, z], 
    zCoord[z]}, {z, 0, H}, {t, 0, theta[z]}, 
   PlotStyle -> Directive[Opacity[0.8], Blue], Mesh -> None];
bottomFilled = 
  ParametricPlot3D[{x[radius[0], t, 0], y[radius[0], t, 0], 0}, {t, 0,
     theta[0]}, PlotStyle -> Directive[Opacity[0.8], Blue], 
   Mesh -> None];
topFilled = 
  ParametricPlot3D[{x[radius[H], t, H], y[radius[H], t, H], H}, {t, 0,
     theta[H]}, PlotStyle -> Directive[Opacity[0.8], Blue], 
   Mesh -> None];
topLine = 
  Graphics3D[{Thick, Blue, 
    Line[{{x[radius[H], 0, H], y[radius[H], 0, H], 
       H}, {x[radius[H], theta[H], H], y[radius[H], theta[H], H], 
       H}}]}];

Show[sideFilled, bottomFilled, topFilled, topLine, PlotRange -> All, 
 AxesLabel -> {"x", "y", "z"}, Boxed -> True]

enter image description here

However, I cannot seem to fill the three surfaces: both bases and the side curved surface around the "cone". Any idea how to include these?

$\endgroup$

2 Answers 2

8
$\begingroup$

Edit

To get a smooth filling,we seperately draw the pieces of boundary surfaces.

Clear["Global`*"];
R = 1;
H = 2;
radius[z_] := R   Exp[-z/H];
theta[z_] := 2   Pi - (Pi   z)/H;
sideFilled = 
  ParametricPlot3D[{radius[z]*Cos[t], radius[z]*Sin[t], z}, {z, 0, 
    H}, {t, 0, theta[z]}, PlotStyle -> Directive[Opacity[0.8], Blue], 
   Mesh -> None];
bottomFilled = 
  ParametricPlot3D[{1 - s, 
      s} . {{0, 0, z}, {radius[z]*Cos[t], radius[z]*Sin[t], z}} /. 
    z -> 0, {t, 0, theta[z] /. z -> 0}, {s, 0, 1}, Mesh -> None];
topFilled = 
  ParametricPlot3D[{1 - s, 
      s} . {{0, 0, z}, {radius[z]*Cos[t], radius[z]*Sin[t], z}} /. 
    z -> H, {t, 0, theta[z] /. z -> H}, {s, 0, 1}, Mesh -> None, 
   PlotStyle -> Cyan];
Filled1 = 
  ParametricPlot3D[{1 - s, 
      s} . {{0, 0, z}, {radius[z]*Cos[t], radius[z]*Sin[t], z}} /. 
    t -> theta[z], {z, 0, H}, {s, 0, 1}, Mesh -> None, 
   PlotStyle -> Red];
Filled2 = 
  ParametricPlot3D[{1 - s, 
      s} . {{0, 0, z}, {radius[z]*Cos[t], radius[z]*Sin[t], z}} /. 
    t -> 0, {z, 0, H}, {s, 0, 1}, Mesh -> None];
Show[sideFilled, topFilled, bottomFilled, Filled1, Filled2, 
 Boxed -> False, Axes -> False]

enter image description here

  • If we set MeshFunctions -> {#4 &}, Mesh -> {{H/ 2}}, PlotPoints -> 60, MaxRecursion -> 2, MeshStyle -> Tube[.02], we can see that when z=H/2, the section is a 3/4 Disk.

enter image description here

Original

  • Not so smoothing.
Clear["Global`*"];
R = 1;
H = 2;
radius[z_] := R   Exp[-z/H];
theta[z_] := 2   Pi - (Pi   z)/H;
reg = ParametricRegion[{1 - s, 
    s} . {{0, 0, z}, {radius[z]*Cos[t], radius[z]*Sin[t], z}}, {{z, 0,
     H}, {t, 0, theta[z]}, {s, 0, 1}}];
BoundaryDiscretizeRegion[reg, MaxCellMeasure -> .01]

enter image description here

$\endgroup$
4
  • $\begingroup$ This is great! Just a minor question. Would it be possible to include the possibility of having a full rotation by $z=H$. Theoretically, I would do theta[z_] := 2Pi - 2(Pi z)/H;, but I get an endpoint issue. To see what I mean, try theta[z_] := 2Pi - 1.999 (Pi z)/H; $\endgroup$
    – sam wolfe
    Commented May 9 at 16:12
  • $\begingroup$ @samwolfe Do you mean Show[RevolutionPlot3D[{radius[z], z}, {z, 0, H}], RevolutionPlot3D[{r, 0}, {r, 0, radius[0]}, {θ, 0, 2 π}, Mesh -> None], RevolutionPlot3D[{r, H}, {r, 0, radius[H]}, {θ, 0, 2 π}, Mesh -> None, PlotStyle -> Cyan], Boxed -> False, Axes -> False] ? $\endgroup$
    – cvgmt
    Commented May 9 at 21:45
  • $\begingroup$ No, I mean allowing the circle to vanish with height. Try replacing my second version of theta in your code and you will see what I mean. Basically making the angle from $0$ to $2\pi$. $\endgroup$
    – sam wolfe
    Commented May 10 at 11:17
  • $\begingroup$ The circle would not vanish until $\theta \to \infty$ or $ z \to \infty$ $\endgroup$
    – Narasimham
    Commented May 12 at 13:47
1
$\begingroup$
H = 2; R = 1; thmax = Pi; r[t_] = R Exp[-t/Pi]; z[t_] = t H/Pi;
shell = ParametricPlot3D[{r[th] Cos[th + v], r[th] Sin[th + v], 
    z[th]}, {th, 0, thmax}, {v, 0, Pi}, PlotStyle -> Yellow];
filament = 
  ParametricPlot3D[{r[th] Cos[th], r[th] Sin[th], z[th]}, {th, 0, 
    thmax}, PlotLabel -> Space_ Curve_on _CCS _SOLID, 
   PlotStyle -> {Red, Thick}];
Show[{filament, shell}, PlotRange -> All, Boxed -> False, 
 PlotLabel -> ConstCompressiveStressSOLID]

Not too different. Since

$$ \frac{dz}{d\theta}= \frac{z}{\theta}=\frac{H}{\pi}$$

(for initial condition at base) and $z$ linearity we can also parameterize with

$$r(\theta)= R e^{-z/H} ~= R e^{-\theta/\pi}$$ for a half of the shell. The portions of planes $\theta=0, z=0$ can be included.

enter image description here

As to the query by @sam wolfe for full rotation $2\pi$ of same height $H=2$, set $ H=R=1, \text{thmax} =2 \pi $ to get a more twisted shell:

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.