17
$\begingroup$

Edit: All the four answers to this question are great, and if you're interested, you should take a look at all the answers. Nevertheless, belisarius' code was accepted since it was closest to what I had in mind.

I'm trying to use Mathematica to help students better understand 3-dimensional views of objects, specifically the "plan view", the "side elevation view" and the "front elevation view", as elaborated upon here.

Given the following example "building", I was able to combine Graphics3D primitives to simulate the object using the following code.

enter image description here

dee = Graphics3D[{Green, Opacity[0.6], Cuboid[{0, 0, 0}, {2/3, 1, 1}],
    Red, Polygon[{{{2/3, 1/2, 0}, {2/3, 1/2, 1}, {3/2, 1/2, 0}}, 
       {{2/3, 1, 0}, {2/3, 1, 1}, {3/2, 1, 0}}, 
       {{2/3, 1/2, 0}, {2/3, 1, 0}, {3/2, 1, 0}, {3/2, 1/2, 0}}, 
       {{2/3, 1/2, 1}, {2/3, 1, 1}, {3/2, 1, 0}, {3/2, 1/2, 0}}}]}]

However, as you can see, the code is rather convoluted, with a great deal of time spent making the red prism. In this case, it was still feasible to manually generate the prism, but what I'm interested in is,

Is there a way to generate a 3D object which is made up of a combination of prisms simply by identifying the vertices at the corner of the object?


If you're interested, my code to allow students to see the three views is as follows, with an example result below.

planviewer = 
  TableForm@{{"3d", "Side", "Front", "Top"}, 
    {Show[#, ViewPoint -> {1, -1, 1}], 
     Show[#, ViewPoint -> {∞, 0, 0}], 
     Show[#, ViewPoint -> {0, -∞, 0}], 
     Show[#, ViewPoint -> {0, 0, ∞}]}, 
    {"", 
     Show[#, ViewPoint -> Right], 
     Show[#, ViewPoint -> Front], 
     Show[#, ViewPoint -> Above]}} &;

enter image description here

The following code allows them to manipulate the viewpoint dynamically.

Manipulate[
 Show[dee, ViewPoint -> {10^a, -(10^b), 10^c}], {a, 0, 3}, {b, 0, 3}, {c, 0, 3}]
$\endgroup$
1
  • 1
    $\begingroup$ If you want to teach about the different View* functions and what they do, you might find this answer useful. $\endgroup$
    – rm -rf
    Mar 30, 2013 at 16:59

6 Answers 6

18
$\begingroup$

There are some tricks ... Specifying the prism's vertices is enough (you don't need to take care of the faces) if you use some undocumented methods for finding the convex hull:

v = {{2/3, 1/2, 0}, {2/3, 1/2, 1}, {2/3, 1, 0}, {2/3, 1, 1}, {3/2, 1/2, 0}, {3/2, 1, 0}};
prism@v_:=Cases[ComputationalGeometry`Methods`ConvexHull3D[v,Graphics`Mesh`FlatFaces->False],
                                                                 _GraphicsComplex, Infinity];

Graphics3D[{Green, Opacity[0.6], Cuboid[{0, 0, 0}, {2/3, 1, 1}], Opacity[.6], Red, prism@v}]

Mathematica graphics

$\endgroup$
8
  • $\begingroup$ This is easily turned into a function, polyhedron[v_] := Cases[.. Very nice. (+1) $\endgroup$
    – Michael E2
    Mar 30, 2013 at 18:21
  • $\begingroup$ @MichaelE2 Thanks! Rewritten as a function now. $\endgroup$ Mar 30, 2013 at 18:43
  • $\begingroup$ @belisarius how do you find out about all these undocumented questions? I was trying to search for it, and saw some similar questions on this site, but I think that's the first time I've seen it. Edit: ninja'd by bill. $\endgroup$ Mar 31, 2013 at 3:30
  • $\begingroup$ It's not on this list, by the way :) : mathematica.stackexchange.com/questions/809/… $\endgroup$ Mar 31, 2013 at 3:38
  • $\begingroup$ @VincentTjeng I don't remember how I found this one, probably following some InternalTrace. You can find similar things trying Names["ComputationalGeometry`Methods`*"] $\endgroup$ Mar 31, 2013 at 5:55
14
$\begingroup$

GraphicsComplex is probably what you are looking for. For example, define the vertices for the 3D polygon:

v = {{2/3, 1/2, 0},{2/3, 1/2, 1},{3/2, 1/2, 0},{2/3, 1, 0},{2/3, 1, 1},{3/2, 1, 0}};

and make a list of which vertices should connect to each other:

i = {{1, 2, 3}, {4, 5, 6}, {1, 2, 5, 4}, {1, 3, 6, 4}, {2, 3, 6, 5}};

The first two elements of i represent the two triangular faces of the prism; the final three elements are the three rectangular faces. This is plotted using

Graphics3D[{Opacity[.8], Red, GraphicsComplex[v, Polygon[i]]}]

or you can plot the green cube plus the red prism together:

Graphics3D[{Green, Opacity[0.6], Cuboid[{0, 0, 0}, {2/3, 1, 1}], 
  Opacity[.6], Red, GraphicsComplex[v, Polygon[i]]}]

which gives the figure below. The code is modified from the documentation in GraphicsComplex where you can find all sorts of neat 3D tricks. If they have access, I think the students would benefit from being able to manipulate the 3D illustration themselves -- this seems like a good application for deployed .cdf's.

cube and prism

$\endgroup$
5
  • $\begingroup$ Thanks for the answer! Would it be possible for the one to write some code that immediately identifies which of vertices should be connected to each other to form the faces, keeping in mind that the faces of the prism may not always be in the same plane? Also, I notice that the part of the red prism joining the green cuboid is actually a triangle, and not a rectangle ... is that a problem or simply a visual illusion? $\endgroup$ Mar 30, 2013 at 10:21
  • $\begingroup$ The little triangle on the adjoining face is an illusion that has to do with the shading -- when you rotate the graphic it changes. But to your first question, the answer is no. After all, how can it know what edges you want to connect if you don't tell it? You will get something no matter what edges you connect -- only one of these is the figure you presumably want. $\endgroup$
    – bill s
    Mar 30, 2013 at 10:33
  • $\begingroup$ @VincentTjeng: yes, you can connect the vertices automagically because the faces must form the convex hull. See my answer $\endgroup$ Mar 30, 2013 at 18:54
  • $\begingroup$ Very nice... how does one find "undocumented features"? $\endgroup$
    – bill s
    Mar 31, 2013 at 3:17
  • $\begingroup$ bill I don't remember how I found this one, probably following some InternalTrace. You can find similar things trying Names["ComputationalGeometry`Methods`*"] $\endgroup$ Mar 31, 2013 at 5:59
9
$\begingroup$

You can get away with specifying even less than all the points.

A (right) prism is a planar figure extruded in an orthogonal direction. It would suffice, then, to give the coordinates of that figure (thereby describing one of the two "ends" of the prism) and its intended height. The figure in the question can therefore be created as a collection of two prisms (no Cuboid if you don't care to use it) like this:

Graphics3D[{Opacity[0.6], 
  Green, prism[{{0, 0, 0}, {2/3, 0, 0}, {2/3, 1, 0}, {0, 1, 0}}, 1],
  Red, prism[{{2/3, 1, 0}, {3/2, 1, 0}, {2/3, 1, 1}}, 1/2]}]

Reproduction

The calculations come down to

  1. Find a basis for the polygon's plane by orthogonalizing its vertices relative to their barycenter;

  2. Perform the extrusion by taking the cross product of the basis elements (normalized to the desired height) and adding that to each of the polygon's vertices; and

  3. Describe how the vertices are connected to form the two polygonal ends and each of the sides.

Here is such a solution. Its arguments are pt, a list of the (3D) vertices around the (nondegenerate) polygon, and height, the height of the prism. It produces a 3D graphics object.

prism[pt_List, height_] := Block[{n = Length[pt], normal},
  normal = Cross @@ Orthogonalize[# - Mean[pt] & /@ pt][[1 ;; 2]];
  GraphicsComplex[pt~Join~(height normal + # & /@ pt), 
   {Polygon[Range[n]], Polygon[Range[2 n, n + 1, -1]], 
    Polygon[{#, n + #, n +  Mod[# + 1, n, 1], Mod[# + 1, n, 1]}] & /@ Range[n]}]]

To see it in action, let's generate a polygon with a random position and orientation:

basis = RandomReal[NormalDistribution[0, 1], {2, 3}];
pt = ({Cos[#], Sin[#]} & /@ Range[0, 2 \[Pi], 2 \[Pi]/7]).basis

Here is the original polygon as a solid black "floor" drawn with two prisms, one with a positive height and another with a negative height:

Graphics3D[{Opacity[0.75], prism[pt, 1], prism[pt, -1/2], Opacity[1], Black,  Polygon[pt]}]

Prism

This approach is easily extended to non-right prisms by replacing height by the extrusion vector (describing one of the "vertical" edges of the prism) and using that instead of height normal in the code.

$\endgroup$
3
  • $\begingroup$ nice application of math :) just a quick question, when you code as prism[pt_List, height_], pt_List is written as such since it is a list, right? so if i were to code a function f[a_String, b_String], then the variables would be a, b and they must be strings? $\endgroup$ Mar 31, 2013 at 3:35
  • $\begingroup$ See the documentation on Blank. $\endgroup$
    – whuber
    Mar 31, 2013 at 13:19
  • $\begingroup$ Got it, thank you! $\endgroup$ Apr 1, 2013 at 3:01
8
$\begingroup$

Take a look at the output of PolyhedronData[{"Prism", 3}, "Faces"]}, which may help.

Note this isn't exactly a direct answer, but I think the optimal solution here is a tool that would let you... well, like this:

whatThe[n_] := Module[{list = {}, grid = False},
   Grid@List@{
      EventHandler[#, {"KeyDown", "k"} :> (grid = Not[grid])] &[

       Graphics3D[{
            EventHandler[MouseAppearance[Sphere[#, .06],
              Style["\[RightUpDownVector]\[LeftUpDownVector]", Darker@Blue, Large]],
            {"MouseClicked" :> AppendTo[list, ##]}] & /@ Tuples[Range[n], 3],

         (*Opacity[.3],*)Dynamic[Polygon[list]], Thick, Dynamic[Line[list]],
         Thin, Lighter[Gray, .8], Dynamic[If[grid, Line[                
            Select[Subsets[Tuples[Range[n], 3], {2}],
             EuclideanDistance @@ ## == 1 &]], {}]]},

        Boxed -> True, ImageSize -> Large, Axes -> True]],

      Graphics3D[Dynamic[Polygon[list]]], 
      EventHandler[Dynamic[Column[list]],
       {"MouseClicked" :> (CopyToClipboard[list]; Beep[])}]}
   ];

whatThe[4]

You click on points to add them to a list. MAGIC!!! It takes some getting used to... here's one of my attempts at creating a prism:

enter image description here

I couldn't tell what order you have to construct the list in for the resulting polygon to be reasonable, but at the very least it might help you pick some points out. It's also another example of just how ridiculously powerful Mathematica is. The basic working version of this took me like 4 minutes to make. O.O

(Note: A simple improvement might be to use a hotkey to cut the list up as you build the polygon).

Update. Using belisarius's convex hull code:

whatThe[n_] := Module[{list = {}, faces, grid = False},
   faces[v_] := Cases[ComputationalGeometry`Methods`ConvexHull3D[v, 
      Graphics`Mesh`FlatFaces -> False], _GraphicsComplex, Infinity];

   Grid@List@{
      EventHandler[#, {"KeyDown", "k"} :> (grid = Not[grid])] &[

       Graphics3D[{EventHandler[
            MouseAppearance[Sphere[#, .06], 
             Style["\[RightUpDownVector]\[LeftUpDownVector]", 
              Darker@Blue, Large]],
            {"MouseClicked" :> AppendTo[list, ##]}] & /@ Tuples[Range[n], 3],

         (*Opacity[.3],*)Dynamic[faces[list]],
         Thin, Lighter[Gray, .8], Dynamic[If[grid, Line[
            Select[Subsets[Tuples[Range[n], 3], {2}], 
             EuclideanDistance @@ ## == 1 &]], {}]]},

        Boxed -> True, ImageSize -> Large, Axes -> True]],

      Graphics3D[Dynamic[faces[list]]],
      EventHandler[Dynamic[Column[list]],
       {"MouseClicked" :> (CopyToClipboard[list]; Beep[])}]}];

enter image description here

$\endgroup$
1
  • $\begingroup$ +1 amazing. and it helps with the first part of translating the problems in the students' worksheets to the prism I want. now I just need to modify the code such that it accepts multiple convex hulls representing the multiple prisms :) $\endgroup$ Mar 31, 2013 at 2:58
2
$\begingroup$

Prism is built in as of version 10.0:

Graphics3D[{Green, Opacity[0.6], Cuboid[{0, 0, 0}, {2/3, 1, 1}], Red, 
  Prism[{{2/3, 1/2, 0}, {2/3, 1/2, 1}, {3/2, 1/2, 0}, 
   {2/3, 1, 0}, {2/3, 1, 1}, {3/2, 1, 0}}]}]

enter image description here

$\endgroup$
0
$\begingroup$

In version 12 (possibly in versions 10+), the option FlatFaces -> False works with ConvexHullMesh (despite red syntax highlighting):

v = {{2/3, 1/2, 0}, {2/3, 1/2, 1}, {2/3, 1, 0}, {2/3, 1, 1}, {3/2, 1/2, 0}, {3/2, 1, 0}};

ConvexHullMesh[v,  FlatFaces -> False, 
 MeshCellStyle -> {1 -> Directive[Thick, Black], 2 -> Opacity[.5, Red]}] 

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.