With the missing piece from https://mathematica.stackexchange.com/q/136188/121 I can self-answer using [`Nearest`](http://reference.wolfram.com/language/ref/Nearest.html) and [`Graph`](http://reference.wolfram.com/language/ref/Graph.html). Please don't let this post discourage answering as I am eager to see other approaches. Now as a function with at least a little reusability. The second parameter is the search radius. segOrder[segs_, rad_: 0.0001] := ( Flatten[segs, 1] // Nearest[# -> Automatic, #, {2, rad}] & // Cases[{_, _}] // Join[#, Partition[Range[2 Length@segs], 2]] & // Graph // FindPath[#, ## & @@ GraphPeriphery[#]] & // First ) ListLinePlot[Part[Join @@ dat, segOrder[dat]], Frame -> True] [![enter image description here][1]][1] It works on the set with gaps given a sufficient radius: ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True] [![enter image description here][2]][2] ### Extension Here is my application of this ordering to the sorting (and joining) of longer lines. lineSort[lines_, r_: 0.0001] := lines[[All, {1, -1}]] ~segOrder~ r ~Partition~ 2 // Cases[ {a_, b_} :> lines[[⌈a/2⌉, b - a ;; a - b ;; b - a]] ] Now I can do things like this: geo = Import["http://www.rr4w.com/kml/9.kml"]; Cases[geo, Line[x_] :> x, {-4}] // lineSort // Catenate; Graphics[{ Thickness[1/150], Line[%, VertexColors -> Array[ColorData["Rainbow"], Length@%, {0, 1}]] }] [![enter image description here][3]][3] [1]: https://i.sstatic.net/9OoEc.png [2]: https://i.sstatic.net/Ni3Xw.png [3]: https://i.sstatic.net/A8DS3.png