2
$\begingroup$

I want to create the following 3D solid object, which is an octahedron, cutting by six spheres centered at its vertices.

The code is as:

RegionPlot3D[-2 x + 2 y - 2 z + Sqrt[2] >= 
   0 && -2 x - 2 y - 2 z + Sqrt[2] >= 0 && 
  2 x - 2 y - 2 z + Sqrt[2] >= 0 && 2 x + 2 y - 2 z + Sqrt[2] >= 0 && 
  2 x + 2 y + 2 z + Sqrt[2] >= 0 && -2 x + 2 y + 2 z + Sqrt[2] >= 0 &&
   2 x - 2 y + 2 z + Sqrt[2] >= 0 && -2 x - 2 y + 2 z + Sqrt[2] >= 0
  && (-(1/Sqrt[2]) - x)^2 + y^2 + z^2 > 1/4 && 
  x^2 + (1/Sqrt[2] - y)^2 + z^2 > 1/4 && 
  x^2 + y^2 + (-(1/Sqrt[2]) - z)^2 > 1/4 && 
  x^2 + y^2 + (1/Sqrt[2] - z)^2 > 1/4 && 
  x^2 + (-(1/Sqrt[2]) - y)^2 + z^2 > 
   1/4 && (1/Sqrt[2] - x)^2 + y^2 + z^2 > 1/4, {x, -1, 1}, {y, -1, 
  1}, {z, -1, 1}, PlotPoints -> 250, Mesh -> None, 
 PlotTheme -> "Classic"]

and the output looks like: enter image description here

There are moustache like black lines on the edge. Increase the PlotPoints option to 250 cannot remove it.

Update:

Outputs with BoundaryStyle->None: enter image description here

How can I obtain desired smooth version of the solid? Why such black lines happen?

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ Try BoundaryStyle -> None. $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jul 27, 2017 at 10:11
  • $\begingroup$ The lines still exist but turn into white or something transparent. $\endgroup$
    – LCFactorization
    Commented Jul 27, 2017 at 10:17
  • 1
    $\begingroup$ I've found Regions to be a bit unreliable when they get really thin like that. An adaptive mesh approach, using DiscretizeRegion with an appropriate MeshRefinementFunction could do the trick. Have a look at 105756, and see if it helps. $\endgroup$
    – aardvark2012
    Commented Jul 27, 2017 at 11:10
  • 2
    $\begingroup$ Using contourRegionPlot3D[] on this problem gives this. $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jul 27, 2017 at 12:52
  • $\begingroup$ Thank you @J.M. , this new function via ContourPlot3D solves my problem. By increasing PlotPoints into 80 or so, the output graph looks pretty good. contourRegionPlot3D is much better than the built-in RegionPlot3D in these aspects if 3D solid model is not needed $\endgroup$
    – LCFactorization
    Commented Jul 28, 2017 at 2:22

1 Answer 1

Reset to default
6
$\begingroup$
  • Since
ineqs=-2  x + 2  y - 2  z + Sqrt[2] >= 
    0 && -2  x - 2  y - 2  z + Sqrt[2] >= 0 && 
   2  x - 2  y - 2  z + Sqrt[2] >= 0 && 
   2  x + 2  y - 2  z + Sqrt[2] >= 0 && 
   2  x + 2  y + 2  z + Sqrt[2] >= 
    0 && -2  x + 2  y + 2  z + Sqrt[2] >= 0 && 
   2  x - 2  y + 2  z + Sqrt[2] >= 
    0 && -2  x - 2  y + 2  z + Sqrt[2] >= 0;
RegionEqual[
 ImplicitRegion[ineqs, {x, y, z}], Octahedron[]]

True

So the solid is the Octanhedron[] remove 6 balls which centers is the vertexs of such Octanhedron[] with 1/2 radius

  • For version 14.1.0, another method work.
$Version

centers = PolyhedronData["Octahedron", "Points"][[;; , 1]];
balls = BoundaryDiscretizeGraphics@Ball[#, 1/2] & /@ centers;
Fold[RegionDifference[#1, #2] &, 
 BoundaryDiscretizeGraphics@Octahedron[], balls]

enter image description here

Or

$Version

centers = PolyhedronData["Octahedron", "Points"][[;; , 1]];
regs = RegionIntersection[
     BoundaryDiscretizeGraphics@
      Octahedron[], #] & /@ (RegionDifference[
       BoundaryDiscretizeRegion@Cuboid[5  {-1, -1, -1}, 5  {1, 1, 1}],
        BoundaryDiscretizeGraphics@Ball[#, 1/2]] & /@ centers);
reg = RegionIntersection @@ regs // BoundaryDiscretizeRegion;
RegionPlot3D[reg]

enter image description here

Or

Needs["OpenCascadeLink`"];
Needs["NDSolve`FEM`"];
centers = PolyhedronData["Octahedron", "Points"][[;; , 1]]; balls = 
 OpenCascadeShapeUnion[
  OpenCascadeShape /@ (Ball[#, 1/2] & /@ centers)]; reg = 
 OpenCascadeShape[
  ToBoundaryMesh@PolyhedronData["Octahedron", "BoundaryMeshRegion"]];
shape = OpenCascadeShapeDifference[reg, balls];
bm = OpenCascadeShapeSurfaceMeshToBoundaryMesh[shape, 
  "ShapeSurfaceMeshOptions" -> {"AngularDeflection" -> 
     0.05}]; Graphics3D[{FaceForm[Orange], EdgeForm[], 
  BoundaryMeshRegion[bm], {FaceForm[], 
   EdgeForm[Directive@{Thick, Cyan}], Octahedron[]}}, Boxed -> False]

enter image description here

Improve this answer
$\endgroup$
0

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.