Centre of Gravity

n = 25;
Elbow[x_] := Log[1 + Exp[x]];
ps = RandomReal[{-1, 0.5}, {n, 2}];
cog = Mean[ps];
colours = ColorData["DarkRainbow"] /@ (RandomReal[{0, 1}, n]);
ps2 = RandomReal[{-0.5, 1}, {n, 2}];
cog2 = Mean[ps2];
colours2 = ColorData["DarkRainbow"] /@ (RandomReal[{0, 1}, n]);
Tmax = 35;
solve[ps_] := (
   NDSolve[
    Flatten@Table[
      With[{norm =
         Elbow[ Sqrt[(x[Mod[i + 1, n, 1]][t] -
              x[i][t])^2 + (y[Mod[i + 1, n, 1]][t] - y[i][t])^2]]},
       {(x[i])'[t] == (x[Mod[i + 1, n, 1]][t] - x[i][t])/ norm,
        (y[i])'[t] ==  (y[Mod[i + 1, n, 1]][t] - y[i][t])/ norm,
        x[i][0] == ps[[i, 1]],
        y[i][0] == ps[[i, 2]]
        }
       ]
      , {i, n}],
    Flatten@Table[{x[i], y[i]}, {i, n}],
    {t, 0, Tmax}
    ]);
soln1 = solve[ps];
soln2 = solve[ps2];
frame[t_] := (
  Module[{t1, t2, op1, op2},
   {t1, t2} =
    0.35 {Exp[Mod[t, 6, 0] - 1], Exp[Mod[t - 3, 6, 0] - 1]};
   op1 = If[Exp[-1] <= t1 <= Tmax,
     Min[0.5 (t1 - Exp[-1])^0.5, Min[1, 0.1 (Tmax - t1)]^0.5], 0];
   op2 = If[Exp[-1] <= t2 <= Tmax,
     Min[0.5 (t2 - Exp[-1])^0.5, Min[1, 0.1 (Tmax - t2)]^0.5], 0];
   Graphics[
    {If[op1 > 0, {Opacity[op1],
       Table[
        With[{p = Evaluate[{x[i][t1], y[i][t1]} /. First[soln1]],
          pp = Evaluate[{x[Mod[i + 1, n, 1]][t1],
              y[Mod[i + 1, n, 1]][t1]} /. First[soln1]]},
         {Opacity[0.8 op1], colours[[i]], Disk[p, 0.05], Line[{p, pp}]}
         ]
        , {i, n}],
       PointSize[Large],
       Red, Point[cog]
       }
      ],
     If[op2 > 0, {Opacity[op2],
       Table[
        With[{p = Evaluate[{x[i][t2], y[i][t2]} /. First[soln2]],
          pp = Evaluate[{x[Mod[i + 1, n, 1]][t2],
              y[Mod[i + 1, n, 1]][t2]} /. First[soln2]]},
         {Opacity[0.8 op2], colours[[i]], Disk[p, 0.05], Line[{p, pp}]}
         ]
        , {i, n}],
       PointSize[Large],
       Red, Point[cog2]
       }
      ]
     }
    , PlotRange -> 0.8, ImageSize -> 200]
   ])

Manipulate[
 frame[t],
 {t, 0, 6}
 ]