6
$\begingroup$

For example, according to the doc, the Ball is a filled ball in 2D and 3D.

However,

Graphics3D[{Ball[]}, 
 ClipPlanes -> InfinitePlane[{{0, 0, 0}, {0, 1, 1}, {1, 1, 2}}]]

Shows a hollow ball, the same as Sphere

enter image description here

What is wrong? How to make the cut object solid, and even better, can set the opacity to it?

update

What I actually want to do is to construct Wigner-Seitz cell by series of middle cutting planes. like this

enter image description here

$\endgroup$
  • $\begingroup$ That's just how it is. All 3D graphics is made up of two-dimensional graphics primitives so it can't be in any other way. $\endgroup$ – C. E. May 8 '17 at 5:22
  • $\begingroup$ @C.E. So how to make it solid? I mean at least, looks like solid when I cut it. I need it to be auto sealed with a face. $\endgroup$ – matheorem May 8 '17 at 5:35
  • $\begingroup$ Show[DiscretizeGraphics@Ball[], ClipPlanes -> InfinitePlane[{{0, 0, 0}, {0, 1, 1}, {1, 1, 2}}]] not pretty but something. $\endgroup$ – Kuba May 8 '17 at 5:40
  • $\begingroup$ @Kuba Oh, no, That's too rough, I need a smooth surface : ) $\endgroup$ – matheorem May 8 '17 at 5:41
  • 2
    $\begingroup$ Your second question is very different from your original question. Maybe you should rewrite the question and focus on the Wigner-Seitz cell question. Saying, perhaps, that you tried using ClipPlanes but it didn't work because the graphics primitive is not solid. $\endgroup$ – C. E. May 8 '17 at 6:49
3
$\begingroup$

Since, ClipPlane always gives a hollow object. So here is a workaround, Thanks to Rahul and Simon Woods's great answer and their function contourRegionPlot3D

Here I show a way to generate Wigner-Seitz cell(a little slow, hope someone can give better solution)

Clear[planeEquation];
planeEquation[point_, perpendicularVec_] := 
  Module[{}, ({x, y, z} - point).perpendicularVec == 0];
planeEquation[p1_, p2_, p3_] := 
  Module[{r = {x, y, z}}, Det[{r - p1, r - p2, r - p3}] == 0];
planeEquation[point_, {vec1_, vec2_}] := 
  Module[{p1 = point, p2 = point + vec1, p3 = point + vec2}, 
   planeEquation[p1, p2, p3]];

Clear[planeRegionEquation];
planeRegionEquation[anchorPoint_, planeEquation_] := 
  Module[{expr = planeEquation[[1]]},
   tmp = expr /. Thread[{x, y, z} -> anchorPoint];
   If[tmp == 0., Print["anchor point is right on the plane, error"]];
   If[tmp > 0, expr > 0, expr < 0]];

Clear[bisectionPlaneEquation];
bisectionPlaneEquation[p1_, p2_] := 
 Module[{midPoint = (p1 + p2)/2, perpendicularVec = p2 - p1}, 
  planeEquation[midPoint, perpendicularVec]]

Clear[contourRegionPlot3D];(*Simon Woods's function, a little modification for performance*)
contourRegionPlot3D[
  region_, {x_, x0_, x1_}, {y_, y0_, y1_}, {z_, z0_, z1_}, 
  opts : OptionsPattern[]] := 
 Module[{}, 
  reg = LogicalExpand[
    region && x0 <= x <= x1 && y0 <= y <= y1 && z0 <= z <= z1];
  If[Head@reg === Or,
   preds = 
    Union@Cases[
      reg, _Greater | _GreaterEqual | _Less | _LessEqual, -1];
   Show@Table[
     ContourPlot3D[
      Evaluate[Equal @@ p], {x, x0, x1}, {y, y0, y1}, {z, z0, z1}, 
      RegionFunction -> 
       Function @@ {{x, y, z}, Refine[reg, p] && Refine[! reg, ! p]}, 
      opts], {p, preds}],
   preds = List @@ reg;
   Show@Table[
     ContourPlot3D[
      Evaluate[Equal @@ preds[[i]]], {x, x0, x1}, {y, y0, y1}, {z, z0,
        z1}, RegionFunction -> 
       Function @@ {{x, y, z}, And @@ Drop[preds, {i}]}, opts], {i, 1,
       Length@preds}]]];

bVecList = {{-1, -1, 1}, {1, 1, 1}, {1, -1, 1}};
pts = DeleteCases[
    Tuples[ConstantArray[Range[-1, 1], 3]], {0, 0, 0}].bVecList;
conditionList = 
  planeRegionEquation[{0, 0, 0}, 
     bisectionPlaneEquation[{0, 0, 0}, #]] & /@ pts;
contourRegionPlot3D[
 And @@ conditionList, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, 
 Mesh -> None]

The above code gives below result and takes more than 3 seconds on my laptop.

enter image description here

And for example in my post, we can do this

contourRegionPlot3D[
 x^2 + y^2 + z^2 < 1 && 
  planeRegionEquation[{1, 1, 1}, 
   planeEquation[{0, 0, 0}, {0, 1, 1}, {1, 1, 2}]], {x, -1.1, 
  1.1}, {y, -1.1, 1.1}, {z, -1.1, 1.1}, Mesh -> None]

this gives

enter image description here

$\endgroup$

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.