$AbbrPrefix = "c"

abbr[expr_] := abbr[expr] = Unique[$AbbrPrefix]

AbbrList[] := Cases[DownValues[abbr], _[_[_[f_]], s_Symbol] -> s -> f]

Structure[expr_, x_] := Collect[expr, x, abbr]

Restore[expr_] := expr /. AbbrList[]


(* try it: *)

test = (Alfa Pi (8 CB CW2 MW2 SW2 Den[S, 0] - 
  ME MW2 SA (C2B SAB + 2 CW2 SBA) Den[S, Mh02] - 
  C2B CA CAB ME MW2 Den[S, MHH2] + 2 CA CBA CW2 ME MW2 Den[S, MHH2] + 
  2 CB CW2 MW2 Den[S, MZ2] - CB CW2 ME MW2 Den[S, MZ2] - 
  2 CB MW2 SW2 Den[S, MZ2] - 8 CB CW2 MW2 SW2 Den[S, MZ2] + 
  CB ME MW2 SW2 Den[S, MZ2] + 8 CB MW2 SW2^2 Den[S, MZ2] + 
  2 CB CW2 ME2 TB2 Den[T, 0] + 2 CB CW2 ME ME2 TB2 Den[T, 0])) / 
 (CB CW2 MW2 SW2)

short = Structure[test, _Den]

