(* C2H6 Molecule after Kimball,non overlapping,parameterized with G2//6-311g *)
Clear[k1,k2,k3,s1,s2,s3]; n=2.;
(* Term from ChemEdu/Kimball/Alkan.sys *)
T=2.25*n*k1/P^2 +(n - 1.0)*2.25*k2/Q^2 + 4.5*(n + 1.0)*k3/R^2;
p =X; p2= p*p; z= 6.; ad= 8./3.; zd= 2./ 3.; vd =4./ 3.; q= P + Q; r= P + R; 
q2= q*q; r2= r*r; r2p2=r2*p2; r2p= r2*p; qr= q*r; qrp=qr*p;

Vee=3.0*n*s1/P+(n - 1.0)*3.0*s2/ Q;
Vee=Vee+(n + 1.0)*6.0*s3/ R + 8.0/ Sqrt[q2];
Vee=Vee+ 24.0/ Sqrt[zd*qr+q2 + r2];
Vee=Vee+ 24.0/ Sqrt[r2] + 4.0/Sqrt[4.0*q2]; 
Vee=Vee+ 24.0/ Sqrt[vd*qr + 4.0*q2 + r2];
Vee=Vee+ 24.0/ Sqrt[ad*r2] + 12.0/ Sqrt[ad*qr + 4.0*q2 +4.0*r2];
Vee=Vee+ 24.0/ Sqrt[ad*qr + 4.0*q2 + vd*r2];

Vne =-2.0*(n + 1.0)*(3.0 -((p - 1.0)*(1.0 + P/ R))^2)/R;
Vne=Vne - 3.0*n*z/ P- 4.0*z/ Sqrt[q2] - 12.0/ Sqrt[zd*qrp + r2p2 + q2];
Vne=Vne- 12.0*z/ Sqrt[r2] - 12.0/ Sqrt[r2p2] - 4.0*z/ Sqrt[4.0*q2];
Vne=Vne- 12.0*z/ Sqrt[vd*qr + 4.0*q2 + r2] ;
Vne=Vne- 12.0/ Sqrt[vd*qrp + r2p2 + 4.0*q2];
Vne=Vne- 24.0/ Sqrt[zd*r2p + r2p2 + r2];
Vne=Vne-12.0/ Sqrt[vd*qr + vd*qrp + 2.0*r2p + r2p2 + 4.0*q2 + r2];
Vne=Vne- 24.0/ Sqrt[vd*qr + vd*qrp - zd*r2p + r2p2 + 4.0*q2 + r2];

Vnn =6.0*z/ Sqrt[r2p2] + z*z/ Sqrt[4.0*q2];
Vnn=Vnn+ 6.0*z/ Sqrt[vd*qrp + r2p2 + 4.0*q2] + 6.0/ Sqrt[ad*r2p2];
Vnn=Vnn+ 3.0/ Sqrt[ad*qrp + 4.0*r2p2 + 4.0*q2];
Vnn=Vnn+ 6.0/ Sqrt[ad*qrp + vd*r2p2 + 4.0*q2];

func = T + Vne + Vee + Vnn;
(* Parameterliste c *)
c = {k1 -> 1.02246687,k2 -> 1.37426345,k3 -> 1.20537762,s1 -> 0.30582536,s2 -> 0.30677632,s3 -> 0.35441063};
func=func /. c;

t = FindMinimum[func,{P,0.26},{Q,1.19},{R,1.25},{X,1.35}, Method->"Newton"]

u = t[[2]];
N[Vne /.u,10]
N[Vee /.u /.c,9]
N[Vnn /.u,8]
ch = X*(P + R) /.u;
dch = ch*0.529177  (* C-H Abstand *)
cc = 2.*(P + Q) /.u;
dcc=cc*0.529177  (* C-C Abstand *)
N[-(Vne + Vee + Vnn)/T /.u /.c,9]  (* Virial Theorem *)
(-t[[1]] - n*37.784301 - n - 1.0)*627.50956 (*Atomisierungsenergie 0 K in kcal/mol *)

plot1 = Graphics[{Circle[{-(P + Q),0},P],Disk[{-(P + Q),0},0.1],Circle[{P + Q,0},P],Disk[{P + Q,0},0.1],Circle[{0,0},Q],Circle[{-(P + Q)-(P + R)/3.,-(P + R)*Sqrt[8./ 9.]},R],Disk[{-(P + Q)- p*(P + R)/3.,-p*(P + R)*Sqrt[8./ 9.]},0.1],Circle[{P + Q +(P + R)/3.,(P + R)*Sqrt[8./ 9.]},R],Disk[{(P + Q)+ p*(P + R)/3.,p*(P + R)*Sqrt[8./ 9.]},0.1],{Dashing[{0.03,0.03}],
Circle[{(P + Q)+(P + R)/3.,-(P + R)*Sqrt[2./ 9.]},R],Disk[{P + Q + p*(P + R)/3.,-p*(P + R)*Sqrt[2.]/3.},0.1],Circle[{-(P + Q)-(P + R)/3.,(P + R)*Sqrt[2./ 9.]},R],Disk[{-(P + Q)-p*(P + R)/3.,p*(P + R)*Sqrt[2.]/3.},0.1]},{Thickness[0.01],Line[{{-(P + Q),0},{P + Q,0}}],Line[{{P + Q,0},{P + Q + p*(P + R)/3.,p*(P + R)*Sqrt[8./ 9.]}}],Line[{{-(P + Q),0},{-(P + Q)- p*(P + R)/3.,-p*(P + R)*Sqrt[8./ 9.]}}],
{Dashing[{0.01,0.01}],
Line[{{P + Q,0},{P + Q + p*(P + R)/3.,-p*(P + R)*Sqrt[2./ 9.]}}],
Line[{{-(P + Q),0},{-(P + Q) - p*(P + R)/3.,p*(P + R)*Sqrt[2./ 9.]}}]}}}] /. u;

Show[plot1,{AspectRatio -> Automatic,PlotRange -> All,Axes -> True,GridLines -> Automatic,Frame -> True}]