How to Plot Prism in Graphics3D

Question

I want to create an image of a rectangular prism, but there is no built-in primitive for it.

One method to display a prism is shown in whubers's answer to Mathematica for teaching orthographic projection.

What are some alternative ways to display prisms using Graphics3D, either with polygons or as wireframe-type models? Assume that the prism cross section is defined by a list of points in the plane.

Answer 1

When I think of prisms, the question raises itself whether it's possible to make the 3D shape really look more like an optical prism, in the sense of having realistic Opacity. Realism isn't one of the strong suits of Mathematica because it doesn't have a ray-tracing mode. However, one can achieve some realistic effects with VertexNormals (and VertexColors - but I'll omit them here).

Although VertexNormals are supported for Polygon, the standard built-in shapes like Cuboid don't support these options directly. That lead me to ask whether one can build a prism primitive that supports these newer rendering features. The first thing one should then do is to consolidate as much of the surface as possible into a single Polygon, so that the vertex normals lead to a smooth interpolation across the entire surface.

Specifying a prism as a set of individual flat polygons is not going to allow smooth interpolation between adjacent polygons, but I want smoothness for realistic rendering of shaded surfaces, especially when the cross section is a complicated shape (unlike the triangle that I'll use s the first example).

So here is a starting point for how the above could be done:

ClearAll[prism]

prism[pts_List, h_, opts : OptionsPattern[]] := 
 Module[{bottoms, tops, surfacePoints},
  surfacePoints = 
   Table[Map[PadRight[#, 3, height] &, pts], {height, {0, h}}];
  {bottoms, tops} =
   {Most[#],
      Rest[#]
      } &@surfacePoints;
  Polygon[
     #1,
     VertexNormals -> #1
     ] &[
   Join[Flatten[
     {
      bottoms,
      RotateLeft[bottoms, {0, 1}],
      RotateLeft[tops, {0, 1}],
      tops
      },
     {{2, 3}, {1}}
     ],
    surfacePoints]]
  ]

Graphics3D[{Opacity[.8], Cyan,
  EdgeForm[Lighter[Cyan]],
  prism[{{0, 0}, {0, 1}, {1, 1}}, 1]},
 Boxed -> False, Lighting -> "Neutral", Background -> Darker[Gray]
 ]

The example is what I was calling a "realistic" rendering of an optical prism. At least it has smoothly shaded appearance because the side wall is one single Polygon.

Here is a CountryData polygon where the edges are dashed lines:

usPolygon = (Flatten[#, 1] &@CountryData["USA", "Polygon"][[1]]);

Graphics3D[{Opacity[.6], Orange,
  EdgeForm[Directive[Blue, Dashed]],
  prism[usPolygon, 5]},
 Boxed -> False
 ]

The dashes are all aligned with each other and create a layered effect. The Polygon forming the side wall is non-planar, and therefore it has vertical edges corresponding to the creases in the polygon's surface as it wraps around the prism.

The top and bottom caps are added as separate polygons (their points are contained in the list surfacePoints).

The following explains a little better what "smooth rendering" looks like:

circle = Table[{Cos[f], Sin[f]}, {f, Pi/10, 2 Pi, Pi/10}];
Graphics3D[{Opacity[1], Cyan,
  EdgeForm[Gray],
  prism[circle, 3]},
 Boxed -> False, Background -> Darker[Gray]
 ]

The faces are discrete, but the VertexNormal interpolation that kicks in for a contiguous polygon surface makes the color gradient smooth, instead of looking flat as it does on a standard Cuboid[].

For comparison, here is the same plot as above, but after removing the line VertexNormals -> #1 from the definition of prism. This may of course be more desirable in a geometry class, but my goal was to explore the possibilities for "realism" in this problem.

Edit: Using VertexNormals as it appears in Cylinder[]

The reason the prism in the first image has some appearance of 3D depth to it is that I combined Opacity with a set of VertexNormals that were all emanating radially from the bottom face of the prism. You can even get effects looking like ambient occlusion in corners this way. This is based on the use of VertexNormals that are not actually normal to the surface. It's a trick that's employed commonly in 3D graphics to render detailed surface features without requiring too many polygons.

But when you look at the cylinder example above, the shading is actually too smooth in that the top face isn't clearly distinguished by its shading.

So rather than using "fake" VertexNormals to create gradient effects, I decided to also try a version of prism that assigns the VertexNormals in a geometrically more correct way by making them locally perpendicular to the surface. This is shown here:

ClearAll[prism]
prism[pts_List, h_, opts : OptionsPattern[]] := Module[
  {
   bottoms,
   tops,
   surfacePoints,
   sidePoints},
  surfacePoints = Table[
    Map[
     PadRight[#, 3, height] &, pts],
    {height, {0, h}}
    ];
  {bottoms, tops} =
   {Most[#], Rest[#]} &@surfacePoints;
  sidePoints =
   Flatten[
    {bottoms, RotateLeft[bottoms, {0, 1}], RotateLeft[tops, {0, 1}], 
     tops}, {{2, 3}, {1}}];
  MapThread[
   Polygon[#1, VertexNormals -> (#1 - #2)] &, {
    Join[
     sidePoints, surfacePoints
     ],
    Join[
     Map[
      {0, 0, 1} # &, sidePoints, {2}
      ],
     Map[
      ({1, 1, 0} # + {0, 0, h/2}) &, surfacePoints, {2}
      ]
     ]
    }
   ]
  ]

Graphics3D[{Opacity[1], Cyan, EdgeForm[Gray], prism[circle, 3]}, 
 Boxed -> False, Background -> Darker[Gray]]

What this version does is basically reproduce the implementation of the Cylinder[] primitive, except that the cross section is now arbitrary (the analogy becomes clearer when using EdgeForm[] above).

Answer 2

Maybe something like this:

I do not know what do you want at the end and what do you have so notice that the important thing is to focus on GraphicsComplex and on what {##, 0} & @@@ ... does to set of 2D points.

Graphics3D[
     With[{ver = Flatten[#, 1] &@CountryData[#, "Polygon"][[1]], 
           pop = CountryData[#, "Population"]},
           len = Length@ver;
     GraphicsComplex[
                     Join[({##, 0} & @@@ #), ({##, pop/10^7} & @@@ #)] &@ver,
                     {Hue@RandomReal[], Thick, 
                      Line[{Range@len,
                            Range[len + 1, 2 len], 
                            Sequence @@ Table[{i, i + len}, {i, 1, len, 50}]}]}
 ]
] & /@ {"Poland", "Germany", "France", "Slovakia"}
 ]