4
$\begingroup$

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. enter image description here

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. enter image description here

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}]
$\endgroup$

3 Answers 3

3
$\begingroup$
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]}]

enter image description here

$\endgroup$
2
2
$\begingroup$
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
  }]

enter image description here

$\endgroup$
2
  • $\begingroup$ Why is N@ necessary to prevent an infinite loop? $\endgroup$
    – shirha
    Commented May 2, 2020 at 2:09
  • $\begingroup$ @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. $\endgroup$
    – C. E.
    Commented May 2, 2020 at 6:30
2
$\begingroup$

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}]

Manipulate object

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

Manipulate object

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – shirha
    Commented May 2, 2020 at 16:29
  • $\begingroup$ That's worth asking as a separate question. $\endgroup$ Commented May 2, 2020 at 17:16

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.