three-dimensional graphic objects that are not simple cuboids

Question

I am trying to draw some graphics with Mathematica. The objects I want to draw are just a little bit more complex than a cuboid -- the difference being that the top and bottom faces are of different depth. Below are two examples of the objects I would like to draw.

p01 = RegionPlot3D[ y <= 1 - 0.5 z, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, 
  Mesh -> None]

p02 = RegionPlot3D[ 
  y <= 0.5 + 0.5 (z - 1), {x, 0, 1}, {y, 0, 1}, {z, 1, 2}, 
  Mesh -> None] 

It would be great if I could make these objects using 3-D graphics primitives found in Mathematica. Then I would be able to make 3-D graphics, placing the objects in relation to one another. Below is an example of what I would like to do, basically creating a set of these 6-faced objects and stacking them in relation to one another.

cubeA = Cuboid[{0, 0, 0}, {1, 0.5, 1}];

cubeB =  Cuboid[{0, 0, 1}, {1, 1, 2}];

Graphics3D[{cubeA, cubeB}]

The example above uses the built-in Cuboid object. The objects I would like to make are (only so slightly) more complex than this. I can create the geometry I am interested in with RegionPlot3D, but I cannot easily combine these. For example, the following fails:

Graphics3D[{p01, p02}]

I tried to do this with Polygon function, but couldn't quite determine how to extend the examples provided to making a 6-faced objects.

Any recommendations or suggestions would be welcome. Thanks.

Answer 1

If your polyhedra are as regular* as the two examples, the coordinates can be Sorted into a predictable order, and the following works:

hexahedron[faceEqns_] := hexahedron[{x, y, z} /. Solve[faceEqns, {x, y, z}]];
hexahedron[vertices_?MatrixQ] := 
 With[{v = Sort@vertices}, 
  Polygon[v[[#]] & /@ {{1, 2, 3, 4}, {8, 7, 6, 5}, {1, 5, 6, 2},
    {3,  7, 8, 4}, {1, 4, 8, 5}, {2, 6, 7, 3}}]]

Just pass the equations for the faces to hexahedron:

Graphics3D[{
  FaceForm[Red, Yellow], EdgeForm[Directive[Thick, Black]], 
  hexahedron[{y == 0 || y == 1 - 0.5` z, x == 0 || x == 1, z == 0 || z == 1}]
 }]

Or if you know the vertices, just pass them:

Graphics3D[{
  FaceForm[Red, Yellow], EdgeForm[Directive[Thick, Black]], 
  hexahedron[{{0, 0, 0}, {0, 0, 1}, {0.`, 0.5`, 1.`}, {0.`, 1.`, 0.`},
     {1, 0, 0}, {1, 0, 1}, {1.`, 0.5`, 1.`}, {1.`, 1.`, 0.`}}]
  }]

---

Edit: Note* and generalization

Note*

*...as regular as the two examples: Note that for the vertices to be sorted into a working order, two conditions have to be met:

1. The x coordinates of the region must lie between two quadrilaterals, each in a plane of the form x == f[y,z], such that all the x coordinates of the vertices of one quadrilateral are less than the x coordinate of each vertex of the other.
2. Similarly one pair of opposite edges of each quadrilateral in 1 must satisfy an additional equation of the form y == g[z] such that the y coordinates of the end points of one are less than the y coordinate each end point of the other.

These restrictions are relaxed in the generalization below.

@belisarius's method with RegionPlot3D may be more robust in this regard, although for more skewed shapes RegionPlot3D does not always easily find the vertices. Figures can be transformed with Translate, Rotate, Scale, or other GeometricTransforms, some examples of which are shown in @belisarius's answer.

Generalizations

One can generalize to handle a wider range of equations that describe a simple polyhedron with six quadrilateral faces.

For the kind of RegionPlot3D commands in the question, if it predicate and domain arguments can be converted to a certain type of system of inequalities - if they are equivalent to a simple CylindricalDecomposition - then the function below will construct the polyhedron.

The function eqnsFromCmd tries to contruct a simple cylindrical decomposition, which Reduce will return if one exists. Solve then will yield the vertices, sorted according to which sides they belong.

eqnsFromCmd[args_List] := #[[3]] == #[[1]] || #[[3]] == #[[5]] & /@ 
   Quiet[Reduce[And @@ (args /. {{var_Symbol, a_, b_} :> a < var < b, 
         LessEqual -> Less, GreaterEqual -> Greater}), {}], 
    Reduce::ratnz];
sortFn[eqns_] := With[{sides = First /@ List @@ eqns},
    sides /. Thread[{x, y, z} -> #1] & ];
getVertices[eqns_And] := SortBy[{x, y, z} /. Solve[eqns, {x, y, z}], sortFn[eqns]];

The new ordering of the vertices requires a new definition of hexahedron. (The sortFn basically orders the vertices "binarily", so that the indices of vertices of opposite faces differ by a power of 2. The use of GraphicsComplex is an optional alternative to plugging all the vertices directly into Polygon as in the first answer.)

hexahedron2[faceEqns_And] := hexahedron2[getVertices[faceEqns]];
Block[{vertices},
 hexahedron2[vertices_?MatrixQ] := 
  Evaluate@GraphicsComplex[vertices, Polygon[{
      {1, 2, 4, 3}, 4 + Reverse@{1, 2, 4, 3},
      {1, 5, 6, 2}, 2 + Reverse@{1, 5, 6, 2},
      {1, 3, 7, 5}, 1 + Reverse@{1, 3, 7, 5}}]]
 ]

Example:

p03 = RegionPlot3D[ 2 z + y <= 2 x <= 1 + 2 z + 2 y && z/2 <= 2 y <= 1 + z,
   {x, 0, 2.5}, {y, 0, 1}, {z, 0, 1}, Mesh -> None, BoxRatios -> Automatic];

g03 = Graphics3D[{FaceForm[Red, Yellow], EdgeForm[Directive[Thick, Black]], 
  hexahedron2[
   getEqnsFromCmd[{2 z + y <= 2 x <= 1 + 2 z + 2 y && z/2 <= 2 y <= 1 + z,
     {x, 0, 2.5}, {y, 0, 1}, {z, 0, 1}}]]
  }];

Row[{p03, g03}]

Generating the equations from the command itself

@belisarius pointed out one can contruct the equations for the figure from an unevaluated RegionPlot3D command. Here are two similar ways. One way requires p03 to be defined with SetDelayed:

Clear[p03];
p03 := RegionPlot3D[ 2 z + y <= 2 x <= 1 + 2 z + 2 y && z/2 <= 2 y <= 1 + z,
  {x, 0, 2.5}, {y, 0, 1}, {z, 0, 1}, Mesh -> None, BoxRatios -> Automatic];

In each method we select non-option arguments from the command and pass them to eqnsFromCmd above.

SetAttributes[eqnsFromCmd, HoldAll];
eqnsFromCmd[plotcmd_Symbol] := eqnsFromCmd[Evaluate@First[Cases[OwnValues@plotcmd, 
      RegionPlot3D[a__] :> Cases[{a}, Except[_Rule]], Infinity]]];
eqnsFromCmd[plotcmd_RegionPlot3D] := eqnsFromCmd[Evaluate@First[Cases[Hold@plotcmd, 
      RegionPlot3D[a__] :> Cases[{a}, Except[_Rule]], Infinity]]];

Examples:

Graphics3D[{FaceForm[Red, Yellow], EdgeForm[Directive[Thick, Black]], 
  hexahedron2[eqnsFromCmd[p04]]}]

Graphics3D[{FaceForm[Red, Yellow], EdgeForm[Directive[Thick, Black]], 
  hexahedron2[getEqnsFromCmd[
    RegionPlot3D[2 z + y <= 2 x <= 1 + 2 z + 2 y && z/2 <= 2 y <= 1 + z,
     {x, 0, 2.5}, {y, 0, 1}, {z, 0, 1}, Mesh -> None]]]
  }]

Output is as above.

A random example:

eqns1 = And @@ 
   Table[var == Rationalize[RandomReal[.5, 3], 0.001].({x, y, z} /. var -> 0) - 2 ||
         var == Rationalize[RandomReal[.5, 3], 0.001].({x, y, z} /. var -> 0) + 2,
    {var, {x, y, z}}];
Graphics3D[{Hue@RandomReal[], hexahedron2[getVertices[eqns1]]}]

Answer 2

(*Your plot*)
p01 = RegionPlot3D[y <= 1 - 0.5 z, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, 
                   Mesh -> None, Axes -> None, Boxed -> False, PlotPoints -> 2, 
                   MaxRecursion -> 0];

(*Isolate the polygons*)
p = Cases[p01, GraphicsComplex[pos_, r___]];
(*Use them in standard graphics contructs*)
Graphics3D[{p, Translate[p, {2, 0, 0}], 
               Translate[Rotate[p, Pi, {0, 0, 1}, {1, 1, 1}], {0, 2, 2}]}, 
           Boxed -> True]

Edit

Please note that the solution is optimal, in the sense that you are manipulating the minimum possible number of polygons

Graphics3D[{Red, PointSize[Large], Cases[p01, GraphicsComplex[pos_, r___] :> Point@pos]}]