17
$\begingroup$

I want to draw a solid or partially transparent hemisphere above a partially transparent cuboid object in Graphics3D. However, I do not know how to do this such that only half the sphere is drawn. Here's what the object looks like with the full sphere:

SphereOpacity = 0.5;
CuboidOpacity = 0.5;
SphereColor = Blue;
CuboidColor = Orange;
Graphics3D[{SphereColor, Opacity[SphereOpacity], Sphere[{0, 0, 0.5}, 0.5], 
            CuboidColor, Opacity[CuboidOpacity], Cuboid[{-5, -5, 0}, {5, 5, 0.5}]}, 
            Boxed -> False
]

figure

How might I proceed to "remove" the bottom half the sphere embedded in the cuboid primitive? In general, is there a way to not render/draw parts of a graphics primitive conditioned intersection with another primitive?

Improve this question
$\endgroup$
4

9 Answers 9

Reset to default
9
$\begingroup$ 
ParametricPlot3D[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}, 
                 {u, 0, π}, {v, 0, π},             
                 Mesh -> None, 
                 Boxed -> False, 
                 Axes -> None
]

some hemisphere

r = 0.5;
d = {0, 0, 0.5}
sphere = ParametricPlot3D[r {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]} + d, 
            {u, -π/2, π/2}, {v, -π/2, π/2}, 
            Mesh -> None, Boxed -> False, Axes -> None][[1]];

SphereOpacity = 0.5;
CuboidOpacity = 0.5;
SphereColor = Blue;
CuboidColor = Orange;
Graphics3D[{SphereColor, Opacity[SphereOpacity], sphere, CuboidColor, 
            Opacity[CuboidOpacity], Cuboid[{-5, -5, 0}, {5, 5, 0.5}]}, 
           Boxed -> False]

hemisphere and box

Improve this answer
$\endgroup$
6
  • $\begingroup$ +1 -- but it's a little bit harder to use this technique to draw an arbitrary hemisphere. :-) $\endgroup$
    – whuber
    May 10, 2013 at 22:50
  • $\begingroup$ @whuber Not with help of GeometricTransformation, I'd say. $\endgroup$
    – Sjoerd C. de Vries
    May 10, 2013 at 22:55
  • $\begingroup$ @SjoerdC.deVries Just for the sake of future readers, you mean GeometricTransformation right? In any case this is great! $\endgroup$
    – QuadraticU
    May 10, 2013 at 23:14
  • $\begingroup$ @QuadraticU Roger that $\endgroup$
    – Sjoerd C. de Vries
    May 10, 2013 at 23:30
  • $\begingroup$ I took the liberty to make this into a function, see my edit $\endgroup$
    – AccidentalTaylorExpansion
    Jun 1, 2022 at 14:25
12
$\begingroup$

To show that there's more than one way to skin a cat, here's another primitive-based method, using NURBS surfaces to render a hemisphere:

With[{r = 1}, 
     Graphics3D[{EdgeForm[],
                 BSplineSurface[Outer[Append[First[#1] #2, Last[#1]] &, 
                       r {{0, 1}, {1, 1}, {1, 0}},
                       {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1], 
                                SplineClosed -> {False, True}, SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1, 1, 1},
                                                {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                                SplineWeights -> Outer[Times, {1, 1/Sqrt[2], 1},
                                                       {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]},
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

another hemisphere

Change r to vary the radius; the control points in the first argument of BSplineSurface[] can be translated and rotated, if the hemisphere needs to be positioned/oriented differently.

If you're interested in this sort of thing, you can refer to work by Piegl and Tiller, e.g. this paper and their book.

Here's another NURBS representation of a hemisphere:

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

still another hemisphere

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did here) minimizes the blemishes to a barely noticeable spot.

Improve this answer
$\endgroup$
7
  • $\begingroup$ Is there a way to get rid of the blemish? $\endgroup$
    – Mr.Wizard
    May 12, 2013 at 19:26
  • $\begingroup$ I haven't figured out how. Weirdly, if I use B-splines for the full sphere, I don't see nasty spots at the poles. $\endgroup$
    – J. M.'s eventual burnout ♦
    May 12, 2013 at 19:28
  • $\begingroup$ Too bad; this method is smoother than the Tube method which shows facets. $\endgroup$
    – Mr.Wizard
    May 12, 2013 at 19:32
  • $\begingroup$ Okay, I found an alternative; the (antipodal) blemishes are now at the rim, but that might be more acceptable to some. $\endgroup$
    – J. M.'s eventual burnout ♦
    May 13, 2013 at 2:07
  • 1
    $\begingroup$ @Mr.Wizard, it took more than two years, but I finally got rid of those blemishes. ;) $\endgroup$
    – J. M.'s eventual burnout ♦
    Feb 26, 2016 at 2:59
11
$\begingroup$

This peculiar method works in Mathematica versions 7 (thanks, Mr. Wizard!) and 8, but apparently no longer in version 9 onwards (per rm and Reb.Cabin):

Graphics3D[{CapForm["Round"], Tube[{{0, 0, 0}, {0, 0, 0}}, {0, 1}]}, Boxed -> False]

half a ball

(I know CapForm["Round"] can be omitted, since it's the default; I just wanted to indicate that it's the reason for this behavior.)

Replace the 1 with your desired radius. As has been noted, if you need to put your hemispheres into an arbitrary position/orientation, GeometricTransformation[] comes in handy.

A workaround suggested by Pickett for version 9 involves a slight perturbation of one of the endpoints, like so:

With[{r = 1, ε = $MachineEpsilon},
     Graphics3D[{CapForm["Round"], Tube[{{0, 0, 0}, {0, 0, ε r}}, {0, r}]}, 
                Boxed -> False]]
Improve this answer
$\endgroup$
8
  • $\begingroup$ No, it doesn't work in v9... $\endgroup$
    – rm -rf ♦
    May 11, 2013 at 2:29
  • $\begingroup$ What does the result look like, then? $\endgroup$
    – J. M.'s eventual burnout ♦
    May 11, 2013 at 2:30
  • 2
    $\begingroup$ Well, it just doesn't work with two identical points... but using e.g. Tube[{{0, 0, 0}, {10^(-10), 0, 0}}, {0, 1}] one can get the right shape even in v9 $\endgroup$
    – C. E.
    May 11, 2013 at 11:24
  • 1
    $\begingroup$ @J.M. Yes, they all give a blank image. The perturbation works though, except for "Butt", which gives a blank image. $\endgroup$
    – rm -rf ♦
    May 11, 2013 at 13:30
  • 1
    $\begingroup$ Confirmed that everything in this answer and its comments is still true in V10.2.0.0, i.e., the original doesn't show anything and the workarounds do. $\endgroup$
    – Reb.Cabin
    Jul 20, 2015 at 12:18
7
$\begingroup$

Here is another simple way to draw a hemisphere that makes use of the symmetry axis:

hemisphere = 
  First@RevolutionPlot3D[Sqrt[1 - r^2], {r, 0, 1}, Mesh -> None];

Here you can vary the option PlotPoints if needed, to get a more or less dense polygon mesh.

I also extract the contents of the Graphics3D object before using it. This needs to be done whenever you plan to combine the result of a Plot3D-related function with other objects in a single Graphics3D (and be able to do translations, rotations, etc. on the individual objects). To show how it works, here is an example:

plant = First@ExampleData[{"Geometry3D", "PottedPlant"}];

Graphics3D[{
  Translate[
   Scale[Rotate[
     {Brown,
      hemisphere},
     {{0, 0, -1}, {0, 0, 1}}], 25],
   {0, 0, 28}],
  {Darker[Green], plant}
  },
 Lighting -> "Neutral",
 Boxed -> False]

pottedplant

Edit: a raster based approach in version 9

Motivated by cormullion's answer, here is another way:

data3D = With[{reso = .05},
   Table[Boole[x^2 + y^2 + z^2 <= 1
          && 
       z >= 0 || (-5 < x < 5) && (-5 < y < 5) && (-0.5 < z < 
         0)], {x, -2, 2, reso}, {y, -2, 2, reso}, {z, -2, 2, reso}]
   ];

Image3D[data3D]

image3d

The Image3D command is not available before version 9, and its rasterized output may not be desirable - but it has a certain appeal in that you get something similar to a RegionPlot3D, but with a more volumetric appearance.

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

Since no-one has done a RegionPlot3D, I'll do one.

RegionPlot3D[
   x^2 + y^2 + z^2 <= 1
   &&
   z >= 0 ||  
   (-5 < x < 5) && (-5 < y < 5) && (-0.5 < z < 0),
 {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
 Mesh -> None,
 PlotPoints -> 120, 
 PlotStyle -> Directive[Orange, Specularity[Yellow, 12], Opacity[0.8]],
 Boxed -> False,
 Lighting -> {{"Directional", White, {{5, 5, 4}, {2, 2, 0}}}},
 BoundaryStyle -> None, 
 ImageSize -> 600,
 Axes -> False]

plot

RegionPlot3D plots always seem to have that 'home-made' look about them...

Improve this answer
$\endgroup$
2
  • $\begingroup$ (+1) That gave me another idea: Image3D... $\endgroup$
    – Jens
    May 11, 2013 at 21:51
  • $\begingroup$ It's also a bit slower than the other methods; it may be worth it to get the neat little "weld" seam, and that little seam might be really helpful if you want to tet-volume-mesh or other discretize this composite shape. $\endgroup$
    – Reb.Cabin
    Jul 20, 2015 at 12:26
3
$\begingroup$

ClipPlanes

In versions 10.0+, we can simply replace Sphere[...] with {ClipPlanes -> {0, 0, 1, -.5}, Sphere[...]} to get the desired output: :

Graphics3D[{SphereColor, Opacity[SphereOpacity],
  {ClipPlanes -> {0, 0, 1, -.5}, Sphere[{0, 0, 0.5}, 1]},
  CuboidColor, Opacity[CuboidOpacity], Cuboid[{-5, -5, 0}, {5, 5, 0.5}]},
 Boxed -> False, ImageSize -> Medium]

enter image description here

Grid[
 Table[
      Graphics3D[{ClipPlanes -> s p, Sphere[]}, 
        PlotLabel -> Style[s p, 16], ImageSize -> Small], 
    {s, {1, -1}}, {p, Append[0] /@ IdentityMatrix[3]}], 
 Dividers -> All]

enter image description here

Improve this answer
$\endgroup$
2
$\begingroup$

Using whuber's method, we can generate a hemisphere with elevation $\alpha$ and horizon $\theta$ using ContourPlot as follows:

α = 0;
θ = 0;

normal = Cross[{Cos[θ], Sin[θ], 0}, {Cos[α] (-Sin[θ]), Cos[α] Cos[θ], Sin[α]}];

ContourPlot3D[x^2 + y^2 + z^2, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
 Contours -> {1}, ContourStyle -> Opacity[0.5], Mesh -> None, 
 RegionFunction -> Function[{x, y, z}, normal.{x, y, z} >= 0]]
Improve this answer
$\endgroup$
1
  • $\begingroup$ This was a bit too long to leave as a comment. $\endgroup$
    – QuadraticU
    May 10, 2013 at 23:11
2
$\begingroup$

One could also make use of Region and ImplicitRegion:

Region[ImplicitRegion[x^2 + y^2 + z^2 <= 1 && z >= 0, {x, y, z}]]

The previous object can be used in the following way:

hemisphere = 
  Region[ImplicitRegion[x^2 + y^2 + z^2 <= 5 && z >= 0, {x, y, z}]];
Show[
 {
  hemisphere,
  Graphics3D[{Red, Opacity[0.5], Cuboid[{-5, -5, 0}, {5, 5, 0.5}]},
   Boxed -> False]
  }
 ]

Results look as shown on the next images; the first one is the actual hemisphere and the second one is the hemisphere on a cuboid.

This the hemisphere object This is the hemisphere on a cuboid Cheers,

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

I made a function out of Sjoerd's answer because I feel the need to make a hemisphere is something that more people experience.

hemisphere[n_, r_, origin_ : {0, 0, 0}, closed_ : False] := 
 Module[{R, defaultplotstyle},
  R = RotationTransform[{{0, 1, 0}, -n}];
  defaultplotstyle = ("DefaultPlotStyle" /. (Method /. 
         Charting`ResolvePlotTheme[Automatic, Plot3D]))[[1]];
  ParametricPlot3D[
   {
    R[r {Cos[\[Pi] u] Sin[\[Pi] v], Sin[\[Pi] u] Sin[\[Pi] v], 
       Cos[\[Pi] v]}],
    If[closed, R[r v {Cos[2 \[Pi] u], 0, Sin[2 \[Pi] u]}], 
     Sequence[{}]]
    },
   {u, 0, 1}, {v, 0, 1},
   Mesh -> None, PlotStyle -> {defaultplotstyle, defaultplotstyle}
   ]
  ]

Here n is a normal vector such that the open end of the hemisphere points in the direction of the normal, r is the radius, origin is the center of the hemisphere and closed can be set to true if you want the open end to be closed off.

Result:

enter image description here

Source for getting default plotstyle: https://mathematica.stackexchange.com/a/172149/45428

Improve this answer
$\endgroup$

Your Answer

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

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