How to solve trisecting a pentagon

Here is an alternate synthetic geometry approach using GeometricScene.

ri = RandomInstance[
  GeometricScene[{{o -> {0, 0}, d0, 
     p1 -> {-Sqrt[5/8 + Sqrt[5]/8], 1/4 (-1 + Sqrt[5])}, p2, p3, p4, 
     p5, i1, i2, i3, i4, m}, {r -> 1}}, {circ = Circle[o, r], 
    EuclideanDistance[i1, i2] == EuclideanDistance[i2, i3] == 
     EuclideanDistance[i3, i4] == EuclideanDistance[i1, p5], 
    EuclideanDistance[m, p4] == EuclideanDistance[m, p5], 
    EuclideanDistance[o, p1] == EuclideanDistance[o, p3] == 
     EuclideanDistance[o, p5] == r, 
    EuclideanDistance[i2, d0] == EuclideanDistance[d0, i3], 
    GeometricAssertion[{Polygon[{p1, p2, p3, p4, p5}]}, "Regular", 
     "Clockwise"], 
    GeometricAssertion[{i1, i2, i3, i4}, {"Inside", circ}], 
    GeometricAssertion[{i1, i2, i3, i4, d0}, "Collinear"], 
    GeometricAssertion[{p1, i1, p5}, "Collinear"], 
    GeometricAssertion[{p3, i4, p4}, "Collinear"], 
    GeometricAssertion[{p4, m, p5}, "Collinear"], 
    GeometricAssertion[{Line[{p4, p5}], Line[{i1, i4}]}, 
     "Parallel"]}], RandomSeeding -> 1]
pts = ri["Points"];
{EuclideanDistance[i1, i2], EuclideanDistance[i1, p5], 
  EuclideanDistance[i2, i3]} /. pts

GeometricScene Solution


Edit

Maybe this will help you along with your problem. It shows you how to write a Manipulate expression that performs as I think you intend. It confirms that d = .4935 is quite close the trisection point.

In this edit I am adding labels since I found some free time to write the simple—if somewhat tedious—code needed to display them.

dp[d_] := d Sin[2. Pi/5]
pts = {"p1", "p2", "p3", "p4", "p5"};
p = Table[{Cos[θ], Sin[θ]} // N, {θ, π/2 + 2 π/5, -3 π/2 + 2 π/5, -2 π/5}];
DynamicModule[{ln1, ln2, ln3, i1, i2, i3, i4},
  Manipulate[
    ln1 = InfiniteLine[{p[[1]] + {d, 0}, p[[5]] + {d, 0}}]; 
    ln2 = InfiniteLine[{p[[3]] - {d, 0}, p[[4]] - {d, 0}}]; 
    ln3 = InfiniteLine[{p[[5]] + {0, dp[d]}, p[[4]] + {0, dp[d]}}];
    i1 =
      Solve[{x, y} ∈ InfiniteLine[{p[[1]], p[[5]]}] && {x, y} ∈ ln3, {x, y}][[1, All, 2]];
    i2 = Solve[{x, y} ∈ ln1 && {x, y} ∈ ln3, {x, y}][[1, All, 2]];
    i3 = Solve[{x, y} ∈ ln2 && {x, y} ∈ ln3, {x, y}][[1, All, 2]];
    i4 =
      Solve[{x, y} ∈ InfiniteLine[{p[[3]], p[[4]]}] && {x, y} ∈ ln3, {x, y}][[1, All, 2]];
    Column[{
      Graphics[
        {Line[p],
         MapThread[
           Text[pts[[#1]], Offset[#2, p[[#1]]]] &,
           {Range[5], {{-8, 0}, {0, 6}, {9, 0}, {7, -7}, {-7, -8}}}],
         Text["i1", Offset[{9, 7}, i1]],
         Text["i2", Offset[{9, 7}, i2]],
         Text["i3", Offset[{-9, 7}, i3]],
         Text["i4", Offset[{-9, 7}, i4]],
         Text["d", Offset[{0, 7}, (i1 + i2)/2]],
         Text[Subscript["d", "0"], Offset[{0, 7}, (i2 + i3)/2]],
         Text["d", Offset[{0, 7}, (i3 + i4)/2]],
         Text[Subscript["d", "p"], Offset[{8, 0}, {0, p[[5, 2]] + dp[d]/2}]],
         Blue, Line[{{0, p[[5, 2]]}, {0, p[[5, 2]] + dp[d]}}], ln1, ln2, ln3,
         Red, AbsolutePointSize[5], Point[{i1, i2, i3, i4}]},
        ImageSize -> Medium],
      Spacer[{1, 20}],
      Row[{"i1 = ", i1, " i2 = ", i2, "\ni3 = ", i3, " i4 = ", i4}],
      Item[
        Row[{"d = ", d, " dp = ", dp[d], " d0 = ", EuclideanDistance[i2, i3]}],
        Alignment -> Left]},
      Center],
    {d, .45, .55, .0001, ImageSize -> 400}],
    SaveDefinitions -> True]

manipulate