Dealing with numbers too large for machine precision in Graphics

I wonder whether I have understood your question correctly because I know you'll be aware of Clip

data = 
 Clip[#, {-$MaxMachineNumber, $MaxMachineNumber}] & /@ {0, Exp[1000.]}

(*
==> {0, 1.797693135*10^308}
*)

Precision /@ data

(*
==> {\[Infinity], MachinePrecision}
*)


data = RandomReal[10, {10, 2}]~Join~{{0, Exp[1000.]}};

Graphics[Point[data], PlotRange -> {0, 10}]

data = Map[Clip[#, {-$MaxMachineNumber, $MaxMachineNumber}] &, data, 2]

(*
==> {{1.712790207, 2.900090032}, {2.659619591, 
  7.829120544}, {1.961467042, 3.28800444}, {8.391594058, 
  6.895205615}, {7.272335729, 5.320941734}, {2.663140973, 
  0.988927991}, {3.408201238, 2.47708199}, {7.951584505, 
  7.102838229}, {6.826916007, 5.639933047}, {5.307337319, 
  1.629710693}, {0, 1.797693135*10^308}}
*)

Graphics[Point[data], PlotRange -> {0, 10}]

Using @Sjoerd idea of Clipping, maybe you could use too Rescale. Something simple could be a wrapper to rescale every point inside a Graphics:

rescale[things_] := 
 Module[{points = 
    Cases[things, {_?NumericQ, _?NumericQ}, ∞], minmax, 
   rescaled},
  minmax = Transpose[{Min /@ #, Max /@ #} &@Transpose[points]];
  rescaled = Clip[minmax, {-$MaxMachineNumber, $MaxMachineNumber}];
  things /. 
     {x_?NumericQ, y_?NumericQ} :>
       {Rescale[x, minmax[[1]], rescaled[[1]]], 
        Rescale[y, minmax[[2]], rescaled[[2]]]}
  ]

This is just a "draft" since points should be taken only from graphics directives with coordinates, and then filter also the Scaled or Offset coordinates.

Graphics[rescale[{... Points[data], ..., Polygon[poly], ...}]]

Anyway, you will have to adjust the aspect ratio after doing the rescale (the rescale is different for each axis).