# Why ClipPlane show a hollow object for a filled object? Realization of Wigner-Seitz cell or Brillouin Zone

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 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 update 2023-2-26

I optimized @chyanog's solution, especially the PlotRange is adjusted automatically, otherwise it will give misleading result for long vector list.

BZview[bVecList_, opts : OptionsPattern[]] :=
Module[{color, opacity, reduction},
color = OptionValue["color"];
opacity = OptionValue["opacity"];
reduction = OptionValue["reduction"];
pts = DeleteCases[
Tuples[{-1, 0, 1}, 3], {0, 0, 0}] . (bVecList*(1 - reduction));
Graphics3D[{EdgeForm[Thick], FaceForm[color], Opacity[opacity],
RegionIntersection[
BoundaryDiscretizeGraphics[HalfSpace[#, # . #/2],
PlotRange -> (3*MinMax /@ Transpose@pts)] & /@ pts]},
Lighting -> "Neutral",Boxed -> False]
]


The "reduction" is essential for composing different BZ view when there are edges that coincide. For example, define

xx = 1.3;
aCon = {1., 0, 0};
bCon = {0, 1., 0};
cCon = {0, 0, xx};

aPrim = {0, 1./2, xx/2};
bPrim = {0, 1./2, -xx/2};
cPrim = {1., 0, 0};

primVecList = {aPrim, bPrim, cPrim};
conVecList = {aCon, bCon, cCon};


then

Show[BZview[conVecList],
BZview[primVecList, "color" -> Blue]]


gives If we reduce the 2nd BZ a little bit.

Show[BZview[conVecList],
BZview[primVecList, "color" -> Blue, "reduction" -> 0.01]]


We get perfect • 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. May 8, 2017 at 5:22
• @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. May 8, 2017 at 5:35
• Show[DiscretizeGraphics@Ball[], ClipPlanes -> InfinitePlane[{{0, 0, 0}, {0, 1, 1}, {1, 1, 2}}]] not pretty but something.
– Kuba
May 8, 2017 at 5:40
• @Kuba Oh, no, That's too rough, I need a smooth surface : ) May 8, 2017 at 5:41
• 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. May 8, 2017 at 6:49

I think this is a better way to generate Wigner-Seitz Cell.

bVecList = {{-1, -1, 1}, {1, 1, 1}, {1, -1, 1}};
pts = DeleteCases[Tuples[{-1, 0, 1}, 3], {0, 0, 0}].bVecList;
AbsoluteTiming[reg = RegionIntersection[BoundaryDiscretizeGraphics[HalfSpace[#, #.#/2],
PlotRange -> 1] & /@ pts]] 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[]},
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];
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. 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 