# Crop a Pentagram with a Pentagon

Is it possible to crop a Pentagram to a Pentagon region? I would like to remove the tips in figure 1 so it looks like figure 2.

.

Figure 1.

Graphics[{EdgeForm[{Thin, Black}], FaceForm[], RegularPolygon[5], Black,
Line@Table[{Cos[k 2π/5 + 3π/10], Sin[k 2π/5 + 3π/10]}, {k, 0, 4*2*5, 2}]}]


Figure 2.

p = Table[{Cos[θ], Sin[θ]} // N, {θ, π/2 + 2 π/5, -3 π/2 + 2 π/5, -2 π/5}];
mid[p1_, p2_] := p1 + (p2 - p1) .42;
m = mid[p[[#[[1]]]], p[[#[[2]]]]] & /@ {
{1, 2}, {2, 1}, {2, 3}, {3, 2}, {3, 4}, {4, 3}, {4, 5}, {5, 4}, {5,1}, {1, 5}};
star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}}

Graphics[{EdgeForm[{Thin, Black}], FaceForm[], RegularPolygon[5], star}]


rp = RegularPolygon[5];

pentagram = BoundaryDiscretizeRegion @ Polygon @
CirclePoints[{1, 3 Pi/10}, 5][[{1, 3, 5, 2, 4}]];

Graphics[{MeshPrimitives[RegionIntersection[rp, pentagram], 1], RegionBoundary[rp]}]


pentagram = N@Table[{Cos[k 2 \[Pi]/5 + 3 \[Pi]/10], Sin[k 2 \[Pi]/5 + 3 \[Pi]/10]}, {k, 0, 4*2*5, 2}];
lines = RegionIntersection[RegularPolygon[5], Line[pentagram]];

Graphics[{
EdgeForm[{Thin, Black}],
FaceForm[],
RegularPolygon[5],
lines
}]


• Why is N@ necessary to prevent an infinite loop? Commented May 2, 2020 at 2:09
• @shirha What makes you think it's an infinite loop? It's not. It just takes that much longer to find the symbolic expressions for the line segments. It's much easier to find them numerically. Commented May 2, 2020 at 6:30

The region-based solutions are nice, but do more work than necessary. Allow me to present a method based on linear interpolation with some clever shuffling:

Manipulate[With[{sides = Partition[CirclePoints[5], 2, 1, 1]},
Graphics[{{FaceForm[], EdgeForm[Black], RegularPolygon[5]},
Line /@ Transpose[{{1 - u, u}.# & /@ sides,
RotateLeft[{u, 1 - u}.# & /@ sides, 2]}]}]],
{{u, (3 - GoldenRatio)/5}, 0, 1}]


Values of u that are greater than $$1/2$$ will generate your cropped pentagram, e.g.

• Is there an easy way to find all the intersection points when u = .6? I can't figure out how to apply Solve to all the correct pairs of lines without picking them by hand. Commented May 2, 2020 at 16:29
• That's worth asking as a separate question. Commented May 2, 2020 at 17:16