I'd like to draw a dodecahedron with each face carved on the sides so it becomes a pentagram. I wonder how to start to do this kind of task in the Wolfram Language?
Edit:
The result should still be a completely enclosed polyhedron; i.e., the carved out parts should be connected by newly added faces. I don't want the result to have holes.
Answer
Solution from @chuy looks really nice. Although I think that it was a little bit of work around because it's a visualization only, but the defined structure doesn't really represent the carved dodecahedron. Here is my approach of carving a dodecahedron pumpkin into pentagrams.
First we define a function that makes a pentagram from a pentagon.
tau = (2 Sqrt[5])/(5 + Sqrt[5]);
pentagram[pts_] :=
Riffle[pts, #] &@(pts[[# + 1]]*tau + (1 - tau)*
pts[[1 + Mod[# + 2, 5]]] & /@ Range[0, 4, 1]);
Then we apply this function to all faces of dodecahedron.
ind = PolyhedronData["Dodecahedron", "FaceIndices"];
vert = PolyhedronData["Dodecahedron", "VertexCoordinates"];
polyVerts = Reverse@*pentagram /@ (vert[[#]] & /@ ind);
Note the Reverse
, it doesn't have to be there, since it just changes the orientation of the pentagram, but it's required to avoid weird artifacts while rendering, see more discussion here.
Now we need to create inner faces of our pumpkin.
pairs = Partition[#, 2] &@Riffle[#, #*85/100] &@polyVerts;
pairs
contain the outer face and inner face. The last thing to do is create wedges that will connect inner faces with outer faces.
wedges[face_] := (Permute[#, Cycles[{{4, 3}}]] &@Flatten[#, 1] &@
face[[1 ;; -1, #, 1 ;; -1]]) & /@
Partition[#, 2, 1] &@(Range[1, 10]~Join~{1});
Now we need to draw all our polygons: faces and wedges:
Graphics3D[
Join[{EdgeForm[{Black, Thick}], Orange},
Polygon /@ Join[wedges[#], #] & /@ pairs], Boxed -> False]
Edit: It has been requested to have no holes in the resulting polyhedron. So no more pumpkin carving.
Let's make a list of all added vertices and include the original pentagon vertex indices that produced these additional concave vertices.
pairList[l_, r_] := Partition[#, 2] &@Riffle[#, RotateLeft[#, r]] &@ l;
concVerts[vert_, face_] :=
Partition[#, 2] &@
Riffle[Sort /@ pairList[face, 1],
vert[[First[#]]]*tau + (1 - tau)*vert[[Last[#]]] & /@
pairList[face, 2]];
concave = Flatten[#, 1] &@(concVerts[vert, #] & /@ ind);
Now we will fill holes with triangles, every triangle has two concave vertices and one original pentagon vertex.
triang[vert_, up_, edge_,
conc_] := {vert[[#[[1, up]]]], #[[2]], #[[4]]} &@Flatten[#, 1] &@
Select[concave, #[[1]] == edge &];
tri = Flatten[#, 1] &@
Table[triang[vert, i, edges[[j]], concave], {i, 1, 2}, {j, 1,
Length@edges}];
Graphics3D[
Join[Polygon /@ tri, {EdgeForm[{Black, Thick}], Orange},
Polygon /@ polyVerts], Boxed -> False]
Comments
Post a Comment