FindCurvePath for lines (rather than points)

This approach generates the data into newdat.

newdat = {dat[[1]]};
z = 1; k = 1;
While[k < Length@dat, 
 temp = Select[dat, FreeQ[Join[Reverse /@ newdat, newdat], #] &];
 it = Table[
   RegionDistance[Line@newdat[[k]], temp[[i, j]]], {i, 
    Length[dat] - k}, {j, 2}];
 z = Position[it, Min@it][[1, 1]];
 If[it[[z, 1]] > it[[z, 2]], AppendTo[newdat, Reverse@temp[[z]]], 
  AppendTo[newdat, temp[[z]]]]; k++;]

And the results:

ListLinePlot[Join @@ newdat, Frame -> True]
Graphics[Arrow@newdat, Frame -> True]

For the reduced data one arrow stays reversed.

Using FindShortestTour with a custom distance function:

d = Flatten[dat, 1];

dist[a_?OddQ, b_] /; (b == a + 1) := 0.0001 EuclideanDistance[d[[a]], d[[b]]]

dist[a_, b_] := EuclideanDistance[d[[a]], d[[b]]]

o = Most@FindShortestTour[Range[Length@d], DistanceFunction -> dist][[2]]
(* {1, 2, 4, 3, 8, 7, 6, 5, 24, 23, 25, 26, 29, 30, 37, 38, 39, \
40, 43, 44, 35, 36, 31, 32, 27, 28, 21, 22, 17, 18, 14, 13, 15, 16, \
12, 11, 20, 19, 42, 41, 34, 33, 9, 10} *)

Graphics[Arrow /@ Partition[d[[o]], 2]]

Update

A revised version which addresses Mr.Wizard's observations. Performance is still poor though.

segOrder2[segs_] :=
 Module[{d = Flatten[segs, 1], dist, o},
  dist[a_?OddQ, b_] /; (b == a + 1) := 0;
  dist[a_, b_] := 1 + EuclideanDistance[d[[a]], d[[b]]];
  o = FindShortestTour[Range[Length@d], DistanceFunction -> dist][[2]] // 
    If[#[[2]] === 2, Rest, Most][#] &;
  RotateLeft[o, 2 Ordering[dist @@@ Partition[o, 2], -1] - 1]]

With the missing piece from How do I "read out" the vertex names on this graph? I can self-answer using Nearest and Graph. 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]

It works on the set with gaps given a sufficient radius:

ListLinePlot[Part[Join @@ dat2, segOrder[dat2, 0.0001]], Frame -> True]

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