2
$\begingroup$

Consider the following region:

Vol2 = Parallelepiped[{-4.8, -4, 
    15}, {{9.6, 0, 0}, {0, 8, 0}, {0, 0, 4}}];
Vol1 = Parallelepiped[{-0.3, -0.25, 
    15}, {{0.6, 0, 0}, {0, 0.5, 0}, {0, 0, 4}}];
Vol = RegionDifference[Vol2, Vol1];

Its visualization is imperfect:

Region[Style[Vol, Blue, Opacity[0.2], EdgeForm[{Thick, Blue}]]]

enter image description here

Could you please tell me how to get a smooth visualization?

P.S. The method from the question does not work:

Vol // BoundaryDiscretizeRegion // Region`Mesh`MergeCells

BoundaryMeshRegion::bsuncl: The boundary surface is not closed because the edges Line[{{11,14},{21,24},{10,1},{14,7},{24,23},{19,17},{20,19},{13,10},{7,4},{23,22},<<6>>}] only come from a single face.

$\endgroup$
3
  • 1
    $\begingroup$ DiscretizeRegion[vol, MaxCellMeasure -> "Volume" -> 1]? $\endgroup$
    – Michael E2
    Jul 5, 2023 at 22:45
  • $\begingroup$ Or Graphics3D[{EdgeForm[None], vol}, Boxed -> False]? $\endgroup$
    – Michael E2
    Jul 5, 2023 at 22:55
  • 1
    $\begingroup$ Missing the upper and lower surfaces. reg = RegionBoundary[Vol] // DiscretizeRegion; Graphics3D[{FaceForm[ Directive[Opacity[.2], Blue]], EdgeForm[Thick], reg // Region`Mesh`MergeCells}, Boxed -> False] $\endgroup$
    – cvgmt
    Jul 6, 2023 at 1:05

2 Answers 2

2
$\begingroup$

Three ways to get a visualization without internal edge lines:

DiscretizeRegion[vol, MaxCellMeasure -> "Volume" -> 1]

enter image description here

Graphics3D[{EdgeForm[None], vol}, Boxed -> False]

enter image description here

And this can have edge lines at the corners, thought it's a bit roundabout and uses an internal function:

polyContainsQ // ClearAll;
polyContainsQ[poly_Polygon, point_List] := 
  RegionDistance[poly, point] < 1.*^-6; (* tolerance *)
polyContainsQ[poly1_Polygon, poly2_Polygon] := 
  AllTrue[First@poly2, polyContainsQ[poly1, #] &];
polyContainsQ[poly1_Polygon, polys2 : {__Polygon}] := 
  AllTrue[polys2, polyContainsQ[poly1, #] &];

NDSolve`FEM`ToBoundaryMesh[vol, "MeshOrder" -> 1] // MeshRegion[#] & //
    Show // Normal;
% /. polys : {__Polygon} :> 
    GatherBy[polys, #[[1, 1]] Boole@MapThread[Equal, First@#] &] /.
  polys : {__Polygon} :>
   With[{mesh = Graphics`Mesh`MeshObject[{polys}]},
    With[{boundaries = 
       Polygon /@ mesh@"Coordinates"[Most /@ mesh@"BoundaryVertices"]},
     Replace[boundaries,
      {b : {_Polygon} :> First@b,
       b : {__Polygon} :> Catch[
         Do[
          If[polyContainsQ[b[[i]], Drop[b, {i}]],
           Throw[Polygon[First@b[[i]] -> First /@ Drop[b, {i}]]]
           ],
          {i, Length@b}
          ]
         ]}
      ]
     ]] /. _EdgeForm -> Nothing

enter image description here

$\endgroup$
2
$\begingroup$

A little complicates but using method in: Extract 2D quad mesh from 3D hexahedral mesh

bmesh = BoundaryMeshRegion[Vol];
enormal = Chop[Region`Mesh`MeshCellNormals[bmesh, 2]];
mg = MeshConnectivityGraph[bmesh, {1, 2}];
edges = VertexList[mg, {1, _}];
adj = (AdjacencyList[mg, #] & /@ edges)[[All, All, 2]];
corneredges = Pick[edges, Dot @@ enormal[[#]] & /@ adj, x_ /; x < 1];
edges = MeshPrimitives[bmesh, corneredges];

Graphics3D[{Style[Vol, Blue, Opacity[0.2], EdgeForm[None]], {Thick, 
   Blue, edges}}, Boxed -> False]

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.