Hier eine Funktion zur Berechnung der Quersumme

qS[x_]:=Module[{},
qs=x;
While[qs>9,
qs=Total[IntegerDigits[qs]]];
qs]

Ein Test

qS[70006]

Und hier die Quersummen für 2^n

qS/@Table[2^n,{n,0,60}]
ListPlot[%,PlotStyle->{Red,PointSize[.02]}]