I'm trying to create a version of Alberti's window, a figure that represents the projection of a three-dimensional figure onto a two-dimensional plane.

Here are my steps:

1) Create the three-dimensional figure:

myDodecahedronFigure = 
   PolyhedronData["Dodecahedron", "Faces", "Polygon"]}]

2) Extract the vertices and create a line from each to the center of projection (at {10,0,0}):

myVertices = N@PolyhedronData["Dodecahedron", "Vertices"];

myProjectionLines = (Line[{{10, 0, 0}, #}] & /@ myVertices);

3) Put them together with the plane of projection (at x = 6):

 Graphics3D[{Red, myProjectionLines, 
   PointSize[0.01], Point[myVertices],
   Opacity[0.5], Yellow, 
   Polygon[{{6, -2, -2}, {6, -2, 2}, {6, 2, 2}, 
            {6, 2, -2}, {6, -2, -2}}]}],
 ImageSize -> 600

enter image description here

I would like to render the projections of the (red) points and the (blue) edges onto the projection plane.


I have two component problems:

a) I want to include only the points and edges that are visible from the center of projection. (I don't want to hand-select such points.)

b) I want a natural and simple way to render lines and points on the projection plane. (Alas Projection merely projects a vector onto another vector, so that doesn't seem of much help.)


1 Answer 1


We can get the lines connected to vertices visible from vp using the approach from this answer by aardvark2012 and the intersections of those lines with the plane using RegionIntersection:

vp = {10, 0, 0};
poly = Polygon[{{6, -2, -2}, {6, -2, 2}, {6, 2, 2}, {6, 2, -2}}];

rd = RegionDifference[ConvexHullMesh[Prepend[myVertices, vp]], 

lines2 = Select[myProjectionLines, 
   MemberQ[Intersection[MeshCoordinates[rd], myVertices], #[[1,2]]]&];

pointsonpoly = RegionIntersection[poly, #]& /@ lines2;

Graphics3D[{PointSize[0.01], Red, Point[myVertices],
   Green, pointsonpoly,   
   Purple, lines2, 
   Opacity[0.5], Yellow, poly,  
   myDodecahedronFigure[[1]]}, ImageSize -> 600]

enter image description here

  • 1
    $\begingroup$ You constantly amaze me. Who else knows this much about Mathematica?? ($\checkmark$) $\endgroup$ Aug 15, 2019 at 21:52
  • $\begingroup$ Thank you @David for the kind words and the accept. $\endgroup$
    – kglr
    Aug 15, 2019 at 21:56
  • $\begingroup$ @kglr Very impressive way for a "hidden line algorithm" ! I tried your code in MMAv11.0.1 but the RegionDifference isn't evaluated .What could be the reason? Thanks! $\endgroup$ Aug 16, 2019 at 6:29
  • $\begingroup$ @UlrichNeumann, thank you. I don't have access to v11. Apparently v11.2 updates to RegionDifference fixed whatever was broken. $\endgroup$
    – kglr
    Aug 16, 2019 at 6:40
  • $\begingroup$ @kglr Thanks, I have to think about a major update... $\endgroup$ Aug 16, 2019 at 6:43

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.