(* Some crude Mathematica programs for drawing and manipulating 
   triangulated polyhedra. makemin is designed to illustrate
   minima, while makets can show an additional displacement vector,
   and is designed for illustration of transition states. These
   programs have not been optimised for speed! *)

<< Graphics`Master`
(*   triples contructs vector q containing triples of nearest neighbours   *)
dist[{pa_,pb_,pc_},{pd_,pe_,pf_}] = Sqrt[ (pa-pd)^2+(pb-pe)^2+(pc-pf)^2 ];
triples[points_,q_,natms_,cutoff_,m_] :={
m=0,
For[i=1,i<natms+1,i++,
    For[j=1,j<i,j++,
        If[ dist[points[[i]],points[[j]]] < cutoff, 
            For[k=1, k<j, k++,
                If[ dist[points[[k]],points[[j]]] < cutoff,
                     If[ dist[points[[k]],points[[i]]] < cutoff,
                        {m++,q[m]={i,j,k}}, ], ] ] ] ] ],
Print["Cutoff used in triples=",cutoff],
Print["Number of triples=",m]}

(*  makets makes a polyhedron with normal mode displacements
    file1 contains the Cartesian coordinates of the points
    file2 contains the Cartesian coordinates corresponding to the vector displacement
    cutoff is the cutoff to be used in assigning nearest neighbour contacts
    scale is a scaling factor applied to the displacement vector  *)
makets[file1_,file2_,cutoff_,scale_] :=
{
list = ReadList[file1,Number],
points = Partition[list,3],
natoms = Length[points],
a = Table[ Graphics3D[ { RGBColor[0,0,0], PointSize[0.025], Point[ points[[i]] ] } ], {i,1,natoms} ],
list2 = ReadList[file2,Number],
vec1 = Partition[list2,3],
b1=ListPlotVectorField3D[Table[{points[[j]],vec1[[j]]},{j,1,natoms}],
       ScaleFunction->(scale#&),VectorHeads->True],
m=0,
For[i=1,i<natoms+1,i++,
    For[j=1,j<i,j++,
        If[ dist[points[[i]],points[[j]]] < cutoff, {m++,p[m]={i,j}}, ] ] ],
d=Graphics3D[ 
             Table[
                   {Thickness[0.008],Line[ {points[[p[k][[1]]]],points[[p[k][[2]]]]} ]},{k,1,m}
                  ]
            ],
c=Show[b1,a,d],
Clear[m,q],
triples[points,q,natoms,cutoff,m],
Print["m after triples=",m],
e=Show[Graphics3D[ Table[Polygon[{points[[q[k][[1]]]],points[[q[k][[2]]]],points[[q[k][[3]]]]}],
                        {k,1,m}] ] ],
frame = Show[e,b1,a,SphericalRegion->True,Boxed->False,Lighting->True],
Print["The solid picture is in variable frame and the ball and stick plot is in c"];
};

(*  makemin makes a polyhedron without normal mode displacements
    file1 contains the Cartesian coordinates of the points
    cutoff is the cutoff to be used in assigning nearest neighbour contacts *)
makemin[file1_,cutoff_] :=
{
list = ReadList[file1,Number],
points = Partition[list,3],
natoms = Length[points],
a = Table[ Graphics3D[ { RGBColor[0,0,0], PointSize[0.025], Point[ points[[i]] ] } ], {i,1,natoms} ],
m=0,
For[i=1,i<natoms+1,i++,
    For[j=1,j<i,j++,
        If[ dist[points[[i]],points[[j]]] < cutoff, {m++,p[m]={i,j}}, ] ] ],
d=Graphics3D[ 
             Table[
                   {Thickness[0.008],Line[ {points[[p[k][[1]]]],points[[p[k][[2]]]]} ]},{k,1,m}
                  ]
            ],
c=Show[a,d,DisplayFunction->Identity],
Clear[m,q],
triples[points,q,natoms,cutoff,m],
(* Print["m after triples=",m], *)
e=Show[Graphics3D[ Table[Polygon[{points[[q[k][[1]]]],points[[q[k][[2]]]],points[[q[k][[3]]]]}],
                        {k,1,m}] ] ,DisplayFunction->Identity],
frame = Show[e,a,SphericalRegion->True,Boxed->False,Lighting->True,DisplayFunction->$DisplayFunction],
Print["The solid picture is in variable frame and the ball and stick plot is in c"];
};

(* viewit can be used to change the viewpoint *)
viewit[frame_,x_,y_,z_] := {newframe = Show[frame,ViewPoint->{x,y,z}]}

(* Example *)
makemin["points", 1.2];

viewit[frame, 4, 1, 0]