Animating a Vector Field

I finally found the time to revisit this problem. In the end, I went with determining the correct scaling factors manually. The code below takes a vector field (as a function $v(t,x,y)$), $x$ & $y$ ranges, $t$ range & number of frames as arguments and produces an array of suitably scaled vector plots. The range of scale parameters can be set with Options, as can all the default VectorPlot directives.

Options[vecAnimate] = {
   "scaleMin" -> 0.01, "scaleMax" -> 0.075, 
   "vecScaleFun" -> Automatic
   };
vecAnimate[v_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, {tmin_, tmax_, 
   nFrames_}, opt : OptionsPattern[{vecAnimate, VectorPlot}]] :=

 Module[{
   evalPoints =  
    Reap[VectorPlot[v[0, x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
       EvaluationMonitor :> Sow[{x, y}]]][[-1, 1]],
   tR = Subdivide[tmin, tmax, nFrames][[;; -2]],
   scaleMin = OptionValue["scaleMin"], 
   scaleMax = OptionValue["scaleMax"],
   maxNorms, totalMaxNorm, scales 
   },
  maxNorms = Table[Max @ (Norm /@ (v[t, #1, #2] & @@@ evalPoints)), {t, tR}];
  totalMaxNorm = Max @ maxNorms;
  scales = maxNorms/totalMaxNorm;
  scales = scales * (scaleMax - scaleMin) + scaleMin;
  MapThread[
   VectorPlot[v[#1, x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
     VectorScale -> {#2, Automatic, OptionValue["vecScaleFun"]}, 
     Evaluate@FilterRules[{opt}, Options[VectorPlot]]] &, {tR, scales}]
  ]

Demo (Hertzian Dipole):

With[{ex = 5, r = Sqrt[#.#] &, 
  d0 = {0, 1}}, {v = Function[{t, x, y}, If[r[{x, y}] > .75, 
     Cos[t - r[{x, y}]] (d0/r[{x, y}] - ( {x, y}*({x, y}.d0))/r[{x, y}]^3),
     {0, 0}]]
 }, 
 ListAnimate[
  vecAnimate[v, {x, -ex, ex}, {y, -ex, ex}, {0, 2 \[Pi], 30}, 
   PlotRange -> 1.2 {{-ex, ex}, {-ex, ex}}]
 ]
]

yields

The method above fails in the presence of poles. As in the example, this can be alleviated by just returning a zero vector in some region or above some vector field norm.