How to draw a dodecahedron with each face modified to a pentagram?

First, I defined dd as follows:

dd = Entity["Polyhedron", "Dodecahedron"]
(* regular dodecahedron *)

Probing the properties of this Entity object, I can extract the vertex coordinates (I used Short here to truncate the output):

dd["VertexCoordinates"]//Short
(* {{-Sqrt[1+2/Sqrt[5]],0,Root[1-20 #1^2+80 #1^4&,3]},<<19>>} *)

Now, I can use the property "FaceIndices" to see which coordinate corresponds to which point in the face of each side.

dd["FaceIndices"]
(* {{15, 10, 9, 14, 1}, {2, 6, 12, 11, 5}, {5, 11, 7, 3, 19}, 
    {11, 12, 8, 16, 7}, {12, 6, 20, 4, 8}, {6, 2, 13, 18, 20}, 
    {2, 5, 19, 17, 13}, {4, 20, 18, 10, 15}, {18, 13, 17, 9, 10}, 
    {17, 19, 3, 14, 9}, {3, 7, 16, 1, 14}, {16, 8, 4, 15, 1}} *)

It turns out that the order given is (not surprisingly) for a pentagon rather than a pentagram...

Graphics3D[Arrow[dd["VertexCoordinates"][[dd["FaceIndices"][[1]]]]]]

enter image description here

But a bit of shuffling can correct that. I used Permute and PermutationCycles.

Finally, I want to close the loop and connect the last vertex to the first one (for each face). To do this, I used BSplineCurve with the option SplineClosed -> True.

All together:

pents = BSplineCurve[Permute[#, PermutationCycles[{1, 3, 5, 2, 4}]], 
     SplineDegree -> 1, 
     SplineClosed -> True] & /@ (Part[dd["VertexCoordinates"], #] & /@ 
     dd["FaceIndices"]);

Graphics3D[{Thick, White, pents, Purple, Opacity[0.75], dd["Faces"]}]

enter image description here

And if desired, rather than using BSplineCurve, you can use Polygon to also get a nice effect:

pents2 = Polygon[
     Permute[#, 
      PermutationCycles[{1, 3, 5, 2, 4}]]] & /@ (Part[
       dd["VertexCoordinates"], #] & /@ dd["FaceIndices"]);

Graphics3D[{Thick, White, pents2}, Background -> Black, 
 Lighting -> "Neutral"]

enter image description here


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]

Carved pumpkin

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 &];

edges = PolyhedronData["Dodecahedron", "Edges"];

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]

Carved dodecahedron

Full code on Wolfram Cloud


gr = Show[PolyhedronData["Dodecahedron"], Boxed -> False, ImageSize -> 400];

gr2 = gr /. Polygon[x_] :> Polygon[#[[{1, 3, 5, 2, 4}]] & /@ x];

Row[{gr, gr2}]

enter image description here