n=4;
(* macierz Cartana, słuzy do ortogonalnego rzutowania R4-> R3 *)
cartan={{-1,1,1,-1},{1,-1,1,-1},{1,1,-1,-1}(*{-1,-1,-1,-1}*)};
rys[a_]:=cartan.a
sasiedzi[uu_,vv_,ww_,zz_]:={{vv,uu,ww,zz},{uu,ww,vv,zz},{ww,vv,uu,zz},
{zz,vv,ww,uu},{uu,zz,ww,vv},{uu,vv,zz,ww}}
roznica[a_,b_]:=Complement[{a},sasiedzi@@b]=={}

wierzcholki=Permutations[IdentityMatrix[4]];
krawedzie=Select[
Subsets[wierzcholki,{2}],
roznica[#[[1]],#[[2]]]==True&];
mu={w+x+y+z,w+y+z,w+z,w};
wierzcholkiw=Table[rys[mu.a],{a,wierzcholki}];
krawedziew=Table[{rys[mu.kr[[1]]],rys[mu.kr[[2]]]},{kr,krawedzie}];

momentpoly[x0_,y0_,z0_]:=(
f[a_]:=a/.{x->x0,y->y0,z->z0};odcinek[a_]:=Graphics3D[{Thick,Line[{f[a][[1]],f[a][[2]]}]}];
podpis[nr_]:=Graphics3D[Text[Style[{1,2,3,4}.wierzcholki[[nr]],Medium,Black],1.1f[wierzcholkiw[[nr]]]]];
Show[Union[Table[odcinek[a],{a,krawedziew}],Table[podpis[nr],{nr,1,Length[wierzcholki]}]],Boxed->False])
(*Manipulate[momentpoly[x0,y0,z0],{{x0,3},0,10},{{y0,2},0,10},{{z0,2},0,10},ControlPlacement->Right]*)
momentpoly[1,1,1]

momentpolyk[x0_,y0_,z0_]:=(
f[a_]:=a/.{x->x0,y->y0,z->z0};odcinek[a_]:=Graphics3D[{Thick,Line[{f[a][[1]],f[a][[2]]}]}];
Show[Union[Table[odcinek[a],{a,krawedziew}]],Boxed->False])
wielosciany={{0,0,1},{0,1,0},{0,1,1},{0,1,3},{0,3,1},{1,0,0},{1,0,1},{1,0,3},{1,1,0},{1,1,1},{1,1,3},{1,3,0},{1,3,1},{1,3,3},{3,0,1},{3,1,0},{3,1,1},{3,1,3},{3,3,1}};
Do[Print["Polaryzacja",wiel];Print[momentpolyk@@wiel];Print[" "],{wiel,wielosciany}]

momentpolyp[x0_,y0_,z0_]:=(
f[a_]:=a/.{x->x0,y->y0,z->z0};odcinek[a_]:=Graphics3D[{Thick,Line[{f[a][[1]],f[a][[2]]}]}];
podpis[nr_]:=Graphics3D[Text[Style[wierzcholki[[nr]],Medium,Black],1.1f[wierzcholkiw[[nr]]]]];
Show[Union[Table[odcinek[a],{a,krawedziew}],{ListPlot3D[Table[f[wi],{wi,wierzcholkiw}],Mesh->None]}],Boxed->False,PlotRange->All])
momentpolyp[1,1.5,1]

momentpolyp[1,0,2]