Recalculate line coodinates
If pts
is your list of points,
Graphics[{Line@pts, {PointSize[Medium], Blue, Point@pts}}]
Use ArrayResample
to get a finer mesh,
pts2 = ArrayResample[pts, {500}];
Graphics[{Line@pts, {PointSize[Medium], Red, Point@pts2}}]
A DiscretizeRegion
based solution:
r = DiscretizeRegion[l, MaxCellMeasure -> {"Length" -> 0.01}]
For some reason, MaxCellMeasure -> 0.01
does not work (I've reported this issue, [CASE:4156693]).
Getting the points in the correct order is a bit trickier for this approach, but can be done using the following:
pts = MeshCoordinates[r][[
FindHamiltonianPath@Graph[
UndirectedEdge @@@ First /@ MeshCells[r, 1]
]
]]
The idea here is to construct a graph from all the line segments and to find the path through all the segments.
In order to get a more evenly spaced partition, you can use Interpolate
to obtain a polygonal line that is parameterized by arclength; Subdivide
will provide you with a evenly spaced subdivision of the parameterization interval:
line = Line[{{0.001953, 0.783203}, {0.009766, 0.787109}, {0.013672,
0.787109}, {0.150391, 0.689453}, {0.152344, 0.6875}, {0.154297,
0.685547}, {0.15625, 0.683594}, {0.158203, 0.681641}, {0.160156,
0.679688}, {0.162109, 0.677734}, {0.164062, 0.675781}, {0.166016,
0.673828}, {0.167969, 0.671875}, {0.169922,
0.669922}, {0.171875, 0.667969}, {0.173828, 0.666016}, {0.175781,
0.664062}, {0.177734, 0.662109}, {0.179688,
0.660156}, {0.181641, 0.658203}, {0.183594, 0.65625}, {0.185547,
0.654297}, {0.1875, 0.652344}, {0.189453, 0.650391}, {0.191406,
0.648438}, {0.193359, 0.646484}, {0.220703, 0.623047}, {0.222656,
0.621094}, {0.224609, 0.619141}, {0.226562,
0.617188}, {0.244141, 0.603516}, {0.246094, 0.601562}, {0.261719,
0.589844}, {0.275391, 0.580078}, {0.298828,
0.564453}, {0.318359, 0.552734}, {0.34375, 0.539062}, {0.34375,
0.535156}, {0.353516, 0.529297}}];
a = line[[1]];
t = Join[{0.}, Accumulate[Sqrt[Dot[(Most[a] - Rest[a])^2, ConstantArray[1., 2]]]]];
γ = Interpolation[Transpose[{t, a}], InterpolationOrder -> 1];
n = 100;
b = γ@Subdivide[0., t[[-1]], n];
Graphics[{Line[b], Red, Point[b]}]