Recalculate line coodinates

If pts is your list of points,

Graphics[{Line@pts, {PointSize[Medium], Blue, Point@pts}}]

enter image description here

Use ArrayResample to get a finer mesh,

pts2 = ArrayResample[pts, {500}];
Graphics[{Line@pts, {PointSize[Medium], Red, Point@pts2}}]

enter image description here


A DiscretizeRegion based solution:

r = DiscretizeRegion[l, MaxCellMeasure -> {"Length" -> 0.01}]

Mathematica graphics

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

enter image description here

Tags:

Graphics

Mesh