From: Dr. Paul Fons (paul-fons_at_aist.go.jp)
Date: Sat Aug 25 2001 - 19:51:09 CDT

Hi, I am attempting to write a tcl procedure to make some bonds in my
(very inorganic, simple ZnO wurtzite structure) and am having some
problems. The program runs, but does not generate complete bonds. Any
idea as to what is going on? Thanks for any help.

proc makebonds {limit} { ;# generate bonds for an arbitrary structure
zapbonds ;# zap all current bonds
set bondsmade 0
set allatomlist [[atomselect top "all"] list] ;# all atoms
  foreach atom $allatomlist { ;# loop over all atoms
   set ngrlist [lrange [[atomselect top "within $limit of index $atom"]
list] 1 end]
# puts stdout "Now looping of neighbors $ngrlist for atom: $atom"
   foreach neighbor $ngrlist { ;# loop over all neighbors of a given atom
    if {$neighbor == $atom} {continue}
# set distance [measure rmsd [atomselect top "index $atom"] [atomselect
top "index $neighbor"]]
# puts "starting with neighbor: $neighbor, distance = $distance"
    set mybonds [lindex [[atomselect top "index $atom"] getbonds] 1]
# puts stdout "Adding atom:$neighbor to atom $atom bond list"
    set id [lsearch -exact $mybonds $neighbor]
    if { $id != -1} {
        puts "neighbor: $neighbor is already on atom: $atom list";
        {continue}
    }
    lappend mybonds $neighbor ;# append this neighbor to atoms list
    set mybonds [list $mybonds]
# puts "the bond list is now: $mybonds"
    [atomselect top "index $atom"] setbonds [list $mybonds]
   set bondsmade [expr $bondsmade+1]
   }
  }
return $bondsmade
}

proc zapbonds {} {
  set allatomlist [[atomselect top "all"] list]
  foreach atom $allatomlist {
     set theatom [atomselect top "index $atom"]
     $theatom setbonds {{}}
  }
return 0
}