'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ACD CHEMBASIC DEMO PROGRAM                                          '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' LogK Predictor//LOGK1.BAS                                           '
'                                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' This program is a predictor of metal ions complexes stability       '
'                                                                     '
' NOTE: the documentation goes in a separate file                     '
'                                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


' Global definitions
CONST EndOfPage = 3100
Dim MC As Boolean
Dim Diag As Object



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Main As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LOGK1.BAS                                                                  '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Struct, Asm As Object
Dim MetalAtom, CNstr As String
Dim CoordNum As Integer, OK As Boolean

  Main="Failed or nothing to do"

  OK=GetFirstActiveStructure(struct)
  If Not OK Then Exit Function

  Asm=Struct.Assembly
  Diag=ActiveDocument.ActivePage.Diagrams.Item(1)

  If MetalInStruct(Struct) = "None" Then

    If Not CheckMol(Struct) Then
      ErrOut("Atoms in ligand must be only H, C, N, O")
      Stop
    End if
    MetalAtom = UserIOBox("Enter metal atom name (ex. Ni_2, Eu_3, UO2_2)","Metal atom name","Ni_2")
    CNstr = UserIOBox("Enter metal atom coordination number (from 1 to 9)","Metal atom coordination number",Str(DefaultCN(MetalAtom)))
    CoordNum = Int (Val(CNstr))
    If (CoordNum < 1 Or CoordNum > 9) Then
      ErrOut("Wrong coordination number!")
      Stop
    End if
    If Ligand_IsMC(Struct) Then
      MC=True
    Else
      MC=False
    End if
    CreateComplexes (Struct, MetalAtom, CoordNum)

  Else

    MetalAtom = MetalInStruct(Struct)
    MetalComplex (Struct, MetalAtom)

  End if

  Main = "Completed."
End Function 'Main
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CheckMol(obj As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i,c As Integer
Dim at As Object
Dim s As String

  c=obj.Assembly.Count
  For i=1 to c
    at = obj.Assembly.Item(i)
    s = at.ElSymbol
    If (s<>"C " And s<>"O " And s<>"H " And s<>"N ") Then
      CheckMol = false
      Exit Function
    End if
  Next i

CheckMol = true
End Function 'CheckMol
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function BondOrder(obj As Object, at1 As Object, at2 As Object) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim bonds, bnd As Object, i As Integer
  bonds = obj.AssocBonds(at1)
  For i=1 to bonds.Count
    bnd = bonds.Item(i)
      If IsBond(obj,bnd,at1,at2) Then
        BondOrder = bnd.GetBondOrder
        Exit Function
      End if
  Next i
End Function 'BondOrder
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsBond(obj As Object, bnd As Object, at1 As Object, at2 As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim a1,a2,b1,b2 As Integer
  a1=obj.Assembly.Index(at1)
  a2=obj.Assembly.Index(at2)
  b1=obj.Assembly.Index(bnd.Atom1)
  b2=obj.Assembly.Index(bnd.Atom2)
  If (((a1=b1 And a2=b2) Or (a1=b2 And a2=b1)) And (a1<>a2) And(b1<>b2)) Then
    IsBond = true
    Exit Function
  End if
IsBond = false
End Function 'IsBond
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''!
Function IsBonded(strmol As Object,at1 As Object, at2 As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns True If at1 is bonded to at2 (within strmol)                   '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim atom,alist As Object
  IsBonded=False
  If strmol.GetType<>CB_MOLECULE And strmol.GetType<>CB_STRUCTURE Then Exit Function
  alist=strmol.AssocAtoms(at1)
  For Each atom in alist
    If at2=atom Then
      IsBonded=True : Exit Function
    End if
  Next atom
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Is13(obj As Object, at1 As Object, at2 As Object) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AtomList,at3 As Object
Dim i,n1,n2,Index,count1 As Integer
  Is13 = 0
  Index =0
  set AtomList = obj.AssocAtoms(at1)
  N1=obj.Assembly.Index(at1)
  N2=obj.Assembly.Index(at2)
  count1 = AtomList.Count
  For i = 1 to count1
      At3=AtomList.Item(i)
      If (IsBonded(obj, at2, at3) And N1<>N2) Then
        Index = Index + 1
      End if
  Next i
  Is13 = Index
End Function 'Is13
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Is14(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AtomList,at3 As Object
Dim i,n1,n2,Index,count1 As Integer
  Is14 = 0
  Index =0
  set AtomList = obj.AssocAtoms(at1)
  N1=obj.Assembly.Index(at1)
  N2=obj.Assembly.Index(at2)
  count1 = AtomList.Count
  For i = 1 to count1
    At3=AtomList.Item(i)
    If (Is13(obj, at2, at3)>0 And Not IsBonded(obj, at1, at2) And N1<>N2) Then
      Index = Index + Is13(obj, at2, at3)
    End if
  Next i
  Is14 = Index
End Function 'Is14
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Is15(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AtomList,at3 As Object
Dim i,n1,n2,Index, count1 As Integer


  Is15 = 0
  Index =0

  set AtomList = obj.AssocAtoms(at1)
  N1=obj.Assembly.Index(at1)
  N2=obj.Assembly.Index(at2)
  count1 = AtomList.Count

  For i = 1 to count1
    At3=AtomList.Item(i)
    If (Is14(obj, at2, at3)>0 And Is13(obj, at1, at2)=0 And Not IsBonded(obj, at1, at2)And N1<>N2) Then
      Index = Index + Is14(obj, at2, at3)
    End if
  Next i
  Is15 = Index

End Function 'Is15
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNamin(obj As Object, at As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Neighbours,NeiBonds,AtBonds,at2 As Object
Dim i,j,k,n1,n2 As Integer
Dim ABcount,Ncount,NBcount As Integer
Dim AtomName As String

  IsNamin = false

  AtomName = at.ElSymbol              'Atom must be a nitrogen
  If AtomName <> "N " Then
    IsNamin = false
    Exit Function
  End if

  set AtBonds=obj.AssocBonds(at)    'Nirtogen can has only a single bonds (sp3 hybr)
  ABcount = AtBonds.Count
    For i = 1 to ABcount
      If Atbonds.Item(i).GetBondOrder <> 1 Then
        IsNamin = false
        Exit Function
      End if
    Next i

  set Neighbours = obj.AssocAtoms(at)
  Ncount = Neighbours.Count
  For i = 1 to Ncount                 'Nitrogen neighbours must be a C(sp3) or H only
    at2=Neighbours.Item(i)
    If (at2.ElSymbol <> "C " And at2.ElSymbol <> "H ") Then
      IsNamin = false
      Exit Function
    End if
    set NeiBonds=obj.AssocBonds(at2)
    NBcount = NeiBonds.Count
    For j = 1 to NBcount
      If NeiBonds.Item(j).GetBondOrder <> 1 Then
        IsNamin = false
        Exit Function
      End if
    Next j
  Next i

  IsNamin = true

End Function 'IsNamin
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsOac(obj As Object, at As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Neighbours, CNeighbours, NeiBonds, AtBonds As Object
Dim at1,at2,at3,AtC As Object
Dim i,j,k,n1,n2 As Integer
Dim nC1,nO1,nO2 As Integer
Dim AtomName As String
  IsOac = false
  AtomName = at.ElSymbol              'Atom must be an oxygen
  If AtomName <> "O " Then
    IsOac = false
    Exit Function
  End if
  set Neighbours = obj.AssocAtoms(at)
  set AtBonds=obj.AssocBonds(at)    'Oxygen can has only a single bonds (sp3 hybr)
    For i = 1 to AtBonds.Count
      If Atbonds.Item(i).GetBondOrder <> 1 Then
        IsOac = false
        Exit Function
      End if
    Next i
                                    'Oxygen neighbours must be a C(sp2) and H only
  If Neighbours.Count = 1 Then
    atC=Neighbours.Item(1)
    If atC.ElSymbol <> "C " Then
      IsOac = false
      Exit Function
    End if
  End if

  If Neighbours.Count = 2 Then
    at2=Neighbours.Item(1)
    at3=Neighbours.Item(2)

    If (at2.ElSymbol = "C " And at3.ElSymbol = "H ") Then
        AtC=at2
    End if
    If (at2.ElSymbol = "H " And at3.ElSymbol = "C ") Then
        AtC=at3
    End if
    If (Not((at2.ElSymbol = "C " And at3.ElSymbol = "H ") Or (at2.ElSymbol = "H " And at3.ElSymbol = "C "))) Then
      IsOac = false
      Exit Function
    End if
  End if

  set CNeighbours=obj.AssocAtoms(AtC) 'C_acetic neighbours must be a C(sp3), Oac, and O=
  If CNeighbours.Count <> 3 Then
    IsOac = false
    Exit Function
  End if

  nC1=0
  nO1=0
  nO2=0
  For j=1 to 3
    at1 = CNeighbours.Item(j)
    If (at1.ElSymbol =  "C " And BondOrder(obj,AtC,at1)=1) Then
      nC1=nC1+1
    End if
    If (at1.ElSymbol =  "O " And BondOrder(obj,AtC,at1)=1) Then
      nO1=nO1+1
    End if
    If (at1.ElSymbol =  "O " And BondOrder(obj,AtC,at1)=2) Then
      nO2=nO2+1
    End if
  Next j

  If (nC1<>1 Or nO1<>1 Or nO2<>1) Then
    IsOac = false
    Exit Function
  End if

  IsOac = true

End Function 'IsOac

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNN4(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsNN4 = 0
  x = Is13(obj, at1, at2)
  If (IsNamin(obj, at1) And IsNamin(obj, at2) And x>0) Then
    IsNN4 = x
    Exit Function
  End if
End Function 'IsNN4
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNN5(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsNN5 = 0
  x = Is14(obj, at1, at2)
  If (IsNamin(obj, at1) And IsNamin(obj, at2) And x>0) Then
    IsNN5 = x
    Exit Function
  End if
End Function 'IsNN5
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNN6(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsNN6 = 0
  x=Is15(obj, at1, at2)
  If (IsNamin(obj, at1) And IsNamin(obj, at2) And x>0) Then
    IsNN6 = x
    Exit Function
  End if
End Function 'IsNN6
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsOO5(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsOO5 = 0
  x = Is14(obj, at1, at2)
  If (IsOac(obj, at1) And IsOac(obj, at2) And x>0) Then
    IsOO5 = x
    Exit Function
  End if
End Function 'IsOO5
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsOO6(obj As Object, at1 As Object, at2 As Object) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsOO6 = 0
  x = Is15(obj, at1, at2)
  If (IsOac(obj, at1) And IsOac(obj, at2) And x>0) Then
    IsOO6 = x
    Exit Function
  End if
End Function 'IsOO6
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNO5(obj As Object, at1 As Object, at2 As Object) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsNO5 = 0
  x = Is14(obj, at1, at2)
  If (((IsNamin(obj, at1) And IsOac(obj, at2)) Or (IsNamin(obj, at2) And IsOac(obj, at1))) And x>0) Then
    IsNO5 = x
    Exit Function
  End if
End Function 'IsNO5
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsNO6(obj As Object, at1 As Object, at2 As Object) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim x As Integer
  IsNO6 = 0
  x = Is15(obj, at1, at2)
  If (((IsNamin(obj, at1) And IsOac(obj, at2)) Or (IsNamin(obj, at2) And IsOac(obj, at1))) And x>0) Then
    IsNO6 = x
    Exit Function
  End if
End Function 'IsNO6
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MetalInStruct(obj As Object) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim a, MetalName As String
Dim i, n, nm As Integer
Dim at As Object
  nm=0
  n = obj.Assembly.Count
  For i=1 to n
    at = obj.Assembly.Item(i)
    a = at.ElSymbol
    If (a="Ba" Or a="Be" Or a="Ca" Or a="Cd" Or a="Ce" Or a="Co" Or a="Cr" Or a="Cu" Or a="Dy" Or a="Er" Or a="Eu" Or a="Fe" Or a="Ga" Or a="Gd" Or a="Hg" Or a="Ho" Or a="La" Or a="Lu" Or a="Mg" Or a="Mn" Or a="Nd" Or a="Ni" Or a="Pb" Or a="Pr" Or a="Sm" Or a="Sr" Or a="Tb" Or a="Th" Or a="Tm" Or a="U " Or a="V " Or a="Y " Or a="Yb" Or a="Zn") Then
      nm=nm+1
      MetalName=a
    End if
  Next i

  If nm = 0 Then
    MetalInStruct = "None"
    Exit Function
  End if

  If nm = 1 Then
  select case MetalName
    case "Ba"
         MetalInStruct = "Ba_2"
    case "Be"
         MetalInStruct = "Be_2"
    case "Ca"
         MetalInStruct = "Ca_2"
    case "Cd"
         MetalInStruct = "Cd_2"
    case "Ce"
         MetalInStruct = "Ce_3"
    case "Co"
         MetalInStruct = "Co_2"
    case "Cr"
         MetalInStruct = "Cr_3"
    case "Cu"
         MetalInStruct = "Cu_2"
    case "Dy"
         MetalInStruct = "Dy_3"
    case "Er"
         MetalInStruct = "Er_3"
    case "Eu"
         MetalInStruct = "Eu_3"
    case "Fe"
         MetalInStruct = "Fe_3"
    case "Ga"
         MetalInStruct = "Ga_3"
    case "Gd"
         MetalInStruct = "Gd_3"
    case "Hg"
         MetalInStruct = "Hg_2"
    case "Ho"
         MetalInStruct = "Ho_3"
    case "La"
         MetalInStruct = "La_3"
    case "Lu"
         MetalInStruct = "Lu_3"
    case "Mg"
         MetalInStruct = "Mg_2"
    case "Mn"
         MetalInStruct = "Mn_2"
    case "Nd"
         MetalInStruct = "Nd_3"
    case "Ni"
         MetalInStruct = "Ni_2"
    case "Pb"
         MetalInStruct = "Pb_2"
    case "Pr"
         MetalInStruct = "Pr_3"
    case "Sm"
         MetalInStruct = "Sm_3"
    case "Sr"
         MetalInStruct = "Sr_2"
    case "Tb"
         MetalInStruct = "Tb_3"
    case "Th"
         MetalInStruct = "Th_4"
    case "Tm"
         MetalInStruct = "Tm_3"
    case "U "
         MetalInStruct = "UO2_2"
    case "V "
         MetalInStruct = "VO_2"
    case "Y "
         MetalInStruct = "Y_3"
    case "Yb"
         MetalInStruct = "Yb_3"
    case "Zn"
         MetalInStruct = "Zn_2"
    case Else
      ErrOut("Unknown metal ion")
      Stop
  End select

    Exit Function
  End if

  If nm > 1 Then
    ErrOut("There are more than one metal in drawn structure!")
    Stop
  End if

End Function 'MetalInStr
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





'o''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DefaultCN(MetalAtom As String) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  DefaultCN = 0

  select case MetalAtom

    case "Ba_2"
         DefaultCN = 8
    case "Be_2"
         DefaultCN = 6
    case "Ca_2"
         DefaultCN = 8
    case "Cd_2"
         DefaultCN = 8
    case "Ce_3"
         DefaultCN = 9
    case "Co_2"
         DefaultCN = 6
    case "Cr_3"
         DefaultCN = 6
    case "Cu_2"
         DefaultCN = 6
    case "Dy_3"
         DefaultCN = 9
    case "Er_3"
         DefaultCN = 9
    case "Eu_3"
         DefaultCN = 9
    case "Fe_3"
         DefaultCN = 6
    case "Ga_3"
         DefaultCN = 6
    case "Gd_3"
         DefaultCN = 9
    case "Hg_2"
         DefaultCN = 8
    case "Ho_3"
         DefaultCN = 9
    case "La_3"
         DefaultCN = 9
    case "Lu_3"
         DefaultCN = 9
    case "Mg_2"
         DefaultCN = 6
    case "Mn_2"
         DefaultCN = 7
    case "Nd_3"
         DefaultCN = 9
    case "Ni_2"
         DefaultCN = 6
    case "Pb_2"
         DefaultCN = 8
    case "Pr_3"
         DefaultCN = 9
    case "Sm_3"
         DefaultCN = 9
    case "Sr_2"
         DefaultCN = 8
    case "Tb_3"
         DefaultCN = 9
    case "Th_4"
         DefaultCN = 6
    case "Tm_3"
         DefaultCN = 8
    case "UO2_2"
         DefaultCN = 6
    case "VO_2"
         DefaultCN = 5
    case "Y_3"
         DefaultCN = 8
    case "Yb_3"
         DefaultCN = 9
    case "Zn_2"
         DefaultCN = 6
    case Else
      ErrOut("Unknown metal ion")
      Stop

  End select


End Function 'DefaultCN
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Ligand_IsMC(obj As Object) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim MinCh, at, at1, at2 As Object
Dim qq, i, j, k, Total_Nam As Integer
Dim NamNum(10) As Integer

  Total_Nam = 0
  qq = obj.Assembly.Count
  For i=1 to qq
    at = obj.Assembly.Item(i)
    If IsNamin(obj, at) Then
      Total_Nam = Total_Nam+1
      NamNum(Total_Nam)=i
    End if
  Next i

  For j=1 to Total_Nam
    at1 = obj.Assembly.Item(NamNum(j))
    For k=j+1 to Total_Nam
      at2 = obj.Assembly.Item(NamNum(k))
      If IsMC(obj,at1,at2) Then
        Ligand_IsMC = true
        Exit Function
      End if
    Next k
  Next j

Ligand_IsMC = false
End Function 'Ligand_IsMC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsMC(obj As Object, at1 As Object, at2 As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim MinCh, at, a1, a2, blist, bnd As Object
Dim i,j,k,qq As Integer

  MinCh = obj.MinChain(at1,at2)

  For Each at In MinCh
    If Not obj.IsRing(at) Then
      IsMC = false
      Exit Function
    End if
  Next at

  For i=1 to MinCh.Count
    a1 = MinCh.Item(i)
    blist = obj.AssocBonds(a1)

    For j=i+1 to MinCh.Count
      a2 = MinCh.Item(j)

      For k=1 to blist.Count
        bnd= blist.Item(k)
        If ( IsBond(obj,bnd,a1,a2) And (Not obj.IsRing(bnd)) ) Then
            IsMC = false
            Exit Function
        End if
      Next k
    Next j
  Next i

  IsMC = true
End Function 'IsMC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function C_k_n(k As Integer, n As Integer) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'     k - top index, n - bottom index (k <= n)                              '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i,fki As Integer
  i = n-k
  If n=k Then
    C_k_n = 1
    Exit Function
  End if
'$$$$$$IPl
  fki=fact(k)*fact(i)
  If fki=0 Then
    C_k_n = 0
  Else
'$$$$$$IPl
    C_k_n = int(fact(n)/fki )
  End if
End Function 'C_k_n
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fact(i As Integer) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ifact(11) As Integer
  ifact(1)=1      :   ifact(2)=1        :   ifact(3)=2            : ifact(4)=6
  ifact(5)=24     :   ifact(6)=120      :   ifact(7)=720          : ifact(8)=5040
  ifact(9)=40320  :   ifact(10)=362880  :   ifact(11)= 3628800
  If i<0 Or i>10 Then
    fact=0
  Else
    fact=ifact(i+1)
  End if
End Function 'fact
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MetalComplex (obj As Object, MetalAtom As String)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i,j,n,Total_NDA,mesg,x13,TotalChelates As Integer
Dim Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6 As Integer
Dim at, da, da1, da2, metal, DonorSet As Object
Dim atH, OHbond As Object
Dim a, das, da1s, da2s As String
Dim Res_page, Res_line As Object
Dim l,t,w,h As Integer

  '  mesg = MessageBox("Make sure the M-N bonds are coordinating and M-O bonds are single!", "Lg(K1)", MBB_OK + MBI_EXCLAMATION)

  Nam = 0 : Oac = 0 : TotalChelates = 0
  TotalNN5=0 : TotalNN6=0 : TotalOO5=0 : TotalOO6=0 : TotalNO5=0 : TotalNO6=0

  n = obj.Assembly.Count
  For i=1 to n
    at = obj.Assembly.Item(i)
    a = at.ElSymbol
    If (a="Ba" Or a="Be" Or a="Ca" Or a="Cd" Or a="Ce" Or a="Co" Or a="Cr" Or a="Cu" Or a="Dy" Or a="Er" Or a="Eu" Or a="Fe" Or a="Ga" Or a="Gd" Or a="Hg" Or a="Ho" Or a="La" Or a="Lu" Or a="Mg" Or a="Mn" Or a="Nd" Or a="Ni" Or a="Pb" Or a="Pr" Or a="Sm" Or a="Sr" Or a="Tb" Or a="Th" Or a="Tm" Or a="U " Or a="V " Or a="Y " Or a="Yb" Or a="Zn") Then
      metal = at
      Exit For
    End if
  Next i


  DonorSet = obj.AssocAtoms(metal)
  Total_NDA = DonorSet.Count
  'PRINT "TOTAL_NDA=",Total_NDA

  kill(metal)

  If LigAnd_IsMC(obj) Then
    MC=true
  Else
    MC=false
  End if

  If Total_NDA=1 Then

    da1 = DonorSet.Item(1)
    If (Not (IsNamin(obj,da1) Or IsOac(obj,da1)) ) Then
      ErrOut("Atoms attached to the metal must be either amine N  Or carboxylic O!")
      Stop
    End if

    If IsNamin(obj,da1) Then Nam = 1
    If IsOac(obj,da1)   Then Oac = 1

    a = "logK1 = " + FStr(lg_K1(MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6),10,2)
    mesg = MessageBox(a + Chr(13) + "Copy to ChemSketch?", "Lg(K1)", MBB_YESNO + MBI_EXCLAMATION)
    If mesg = MBR_YES Then
      set Res_page= ActiveDocument.ActivePage
      set Res_line = Res_page.TextBoxes.AddEmpty
      Diag.GetBound(l,t,w,h)
      Res_line.SetContent(a)
      Res_line.SetBound(l,t+h+50, w, 80)
    End if

    Exit Sub
  End if

  For i=1 to Total_NDA
    da1 = DonorSet.Item(i)
    da1s = da1.ElSymbol
    If (Not (IsNamin(obj,da1) Or IsOac(obj,da1)) ) Then
      ErrOut("Atoms attached to metal must be N amine or O acetic only!")
      Stop
    End if

    For j=i+1 to Total_NDA
      da2= DonorSet.Item(j)
      da2s = da2.ElSymbol
      If (Not (IsNamin(obj,da2) Or IsOac(obj,da2)) ) Then
        ErrOut("Atoms attached to metal must be N amine or O acetic only!")
        Stop
      End if

      x13= Is13(obj,da1,da2)
      If (x13>0) Then
        ErrOut("Complex may not contain four-membered chelate rings!")
        Stop
      End if

      If (da1s="N " And da2s="N ") Then
        TotalNN5= TotalNN5 + IsNN5(obj,da1,da2)
        TotalNN6= TotalNN6 + IsNN6(obj,da1,da2)
      End if
      If ((da1s="N " And da2s="O ") Or (da1s="O " And da2s="N ")) Then
        TotalNO5= TotalNO5 + IsNO5(obj,da1,da2)
        TotalNO6= TotalNO6 + IsNO6(obj,da1,da2)
      End if
      If (da1s="O " And da2s="O ") Then
        TotalOO5= TotalOO5 + IsOO5(obj,da1,da2)
        TotalOO6= TotalOO6 + IsOO6(obj,da1,da2)
      End if
    Next j
  Next i

  TotalChelates = TotalChelates+ TotalNN5+ TotalNN6+ TotalNO5+ TotalNO6+ TotalOO5+ TotalOO6
  If TotalChelates > Total_NDA Then   'Check For steric strain
    WarnOut("The ligand is sterically strained. This may decrease the precision of predicted values!")
  End if


  a = "LogK1 = " + FStr(lg_K1(MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6),10,2)


  mesg = MessageBox(a + Chr(13) + "Copy to ChemSketch?", "Lg(K1)", MBB_YESNO + MBI_EXCLAMATION)


  If mesg = MBR_YES Then
    Res_page= ActiveDocument.ActivePage
    Res_line = Res_page.TextBoxes.AddEmpty
    Diag.GetBound(l,t,w,h)
    Res_line.SetContent(a)
    Res_line.SetBound(l,t+h+50, w, 80)
  End if

End Sub 'MetalComplex
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateComplexes (obj As Object, MetalAtom As String, CN As Integer)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim nat,MaxCN,currentCN,Total_NDA,NDA, i,j,k,kk,m,m2,p,n1,n2,l,t,w,h As Integer
Dim DANum(10),Nam, Oac, TotalChelates As Integer
Dim TotalNN4, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6 As Integer
Dim NN4(10,10),NN5(10,10),NN6(10,10),OO5(10,10),OO6(10,10),NO5(10,10),NO6(10,10) As Integer
Dim T_MARGIN,L_MARGIN,H_STRING,STR_SHIFT, lrs As Integer
Dim Output_Box,c,c0,b,bb,n,a, jj(10),qq1,qq2,qq3,jjqq11,jjqq31 As Integer
Dim ResultString ,SConstVal,OutputFormat,els, s1, s2 As String
Dim Begin_line,NDATB,LgK1_TextBox,ResultsPage,at, at1, at2 As Object

  'some  house-keeping

  L_MARGIN = 200 : H_STRING = 60 : STR_SHIFT = 50 : T_MARGIN = 200
  LabelDiagram("E",Diag)

  'analyze donor set

  Total_NDA = 0
  with obj.Assembly
    nat=.Count
    For i=1 to nat
      at = obj.Assembly.Item(i)
      If (IsNamin(obj, at) Or IsOac(obj, at)) Then
        Total_NDA = Total_NDA+1
        If Total_NDA > 10 Then
          ErrOut("Too many donor atoms in the ligand!")
          Stop
        End if
        DANum(Total_NDA)=i
      End if
    Next i
  End with

  'checks again

  If Total_NDA < 1 Then
    ErrOut("There are no allowed donor atoms in the ligand!")
    Stop
  End if



  ' fill in arrays of donor atoms pairs
  TotalChelates = 0
  For i=1 to Total_NDA
    For j=1 to Total_NDA
      NN4(i,j)=0 : NN5(i,j)=0 : NN6(i,j)=0
      OO5(i,j)=0 : OO6(i,j)=0
      NO5(i,j)=0 : NO6(i,j)=0
    Next j
  Next i

  For i=1 to Total_NDA
    At1=obj.Assembly.Item(DANum(i))
    s1=At1.ElSymbol
    For j=1 to Total_NDA
      At2=obj.Assembly.Item(DANum(j))
      s2=At2.ElSymbol
      If (s1="N " And s2="N ") Then
        NN4(i,j)=IsNN4(obj, at1, at2)
        NN5(i,j)=IsNN5(obj, at1, at2)
        NN6(i,j)=IsNN6(obj, at1, at2)
      End if
      If (s1="O " And s2="O ") Then
        OO5(i,j)=IsOO5(obj, at1, at2)
        OO6(i,j)=IsOO6(obj, at1, at2)
      End if
      If ((s1="N " And s2="O ") Or (s1="O " And s2="N ")) Then
        NO5(i,j)=IsNO5(obj, at1, at2)
        NO6(i,j)=IsNO6(obj, at1, at2)
      End if
      TotalChelates = TotalChelates+NN5(i,j)+NN6(i,j)+OO5(i,j)+OO6(i,j)+NO5(i,j)+NO6(i,j)
    Next j
  Next i

  'check For steric strain
  TotalChelates = Int(TotalChelates/2)
  If TotalChelates > Total_NDA Then
    WarnOut("The ligand is sterically strained. This may decrease the precision of prediction!")
  End if


dataout:
  OutputFormat = UserIOBox("Print all values ('ALL') or values For given coordination number ('CN')","Output data Format","ALL")
  OutputFormat = UCase(OutputFormat)

  select case OutputFormat

  case "CN"

    set ResultsPage = ActiveDocument.ActivePage
    Diag.GetBound(l,t,w,h)
    L_MARGIN = l
    T_MARGIN = t+h+50

    If (CN=1 Or Total_NDA=1) Then goto NDA_1
    For kk=2 to 9
      If CN=kk Or Total_NDA=kk Then
        k=kk : goto Local_NDA
      End if
    Next kk

  case "ALL"
  case Else
    ErrOut("Unknown data output Format")
    goto dataout
  End select


  ResultsPage = ActiveDocument.AddEmpty
  Begin_line = ResultsPage.TextBoxes.AddEmpty
  Begin_line.SetContent("Predicted log(K1) for complexes of this ligand with "+MetalAtom+" are as follows:")
  Begin_line.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
  T_MARGIN = T_MARGIN + STR_SHIFT


  ' NDA <= current CN

NDA_1:

  TotalNN5=0 : TotalNN6=0 : TotalOO5=0 : TotalOO6=0 : TotalNO5=0 : TotalNO6=0

  NDATB = ResultsPage.TextBoxes.AddEmpty
  T_MARGIN = T_MARGIN + STR_SHIFT
  ResultString = "Coordination by one ligating atom"
  NDATB.SetContent(ResultString)
  NDATB.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
  T_MARGIN = T_MARGIN + STR_SHIFT

  For i=1 to Total_NDA

    If T_MARGIN >= EndOfPage Then
      set ResultsPage = ActiveDocument.AddEmpty
      T_MARGIN = 200
    End if

    If IsNamin(obj, obj.Assembly.Item(DANum(i))) Then
      Nam=1 : Oac=0
      NDATB = ResultsPage.TextBoxes.AddEmpty
      ResultString = "N" + Trim(Str(DANum(i)))
      SConstVal =FStr(lg_K1(MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6),10,2)
      ResultString ="LogK1 = "+LTrim(SConstVal)+"    [ "+Trim(ResultString) +" ]"
      T_MARGIN = T_MARGIN + STR_SHIFT
      NDATB.SetContent(ResultString)
      NDATB.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
    End if

    If IsOac(obj, obj.Assembly.Item(DANum(i))) Then
      Oac=1 : Nam=0
      NDATB = ResultsPage.TextBoxes.AddEmpty
      ResultString = "O" + Trim(Str(DANum(i)))
      SConstVal=FStr(lg_K1(MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6),10,2)
      ResultString ="LogK1 = "+LTrim(SConstVal)+"    [ "+Trim(ResultString) +" ]"
      T_MARGIN = T_MARGIN + STR_SHIFT
      NDATB.SetContent(ResultString)
      NDATB.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
    End if

  Next i

  T_MARGIN = T_MARGIN + STR_SHIFT
  If (OutputFormat = "CN"  Or CN=1)Then
    goto ends
  End if





  k=2   '3,4,5,6,7,8,9
  If (Total_NDA<k) Then goto ends

Local_NDA:

  If T_MARGIN >= EndOfPage Then
    set ResultsPage = ActiveDocument.AddEmpty
    T_MARGIN = 200
  End if

  If (OutputFormat="ALL") Then
    NDATB = ResultsPage.TextBoxes.AddEmpty
    T_MARGIN = T_MARGIN + STR_SHIFT
    ResultString = "Coordination by  "+Str(k)+" ligating atoms"
    NDATB.SetContent(ResultString)
    NDATB.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
    T_MARGIN = T_MARGIN + STR_SHIFT
  End if

  n=Total_NDA

  Nam=0
  Oac=0

  For i=1 to k
    jj(i)=0
  Next i

  c0=C_k_n(k,n)
  c=0
  begin:

    For b=1 to k
      If jj(b)>=b Then
        a=jj(b)-b-1
        For m=1 to b
          jj(m) = m+a
        Next m
        goto final
      End if
    Next b

    bb = n-k-1
    For m=1 to k
      jj(m)= bb+m
    Next m

final:

    If T_MARGIN >= EndOfPage Then
      set ResultsPage = ActiveDocument.AddEmpty
      T_MARGIN = 200
    End if

    set NDATB = ResultsPage.TextBoxes.AddEmpty

    TotalNN4=0
    TotalNN5=0
    TotalNN6=0
    TotalOO5=0
    TotalOO6=0
    TotalNO5=0
    TotalNO6=0

    For qq1=1 to k-1
      For qq2=1 to k-1
        qq3=qq1+qq2
        If qq3<=k Then
          '$$$$$$IPl
          jjqq11=jj(qq1)+1 : jjqq31=jj(qq3)+1
          If (jjqq11>0 And jjqq31>0) Then
            TotalNN4 = TotalNN4 + NN4(jjqq11,jjqq31)
            TotalNN5 = TotalNN5 + NN5(jjqq11,jjqq31)
            TotalNN6 = TotalNN6 + NN6(jjqq11,jjqq31)
            TotalOO5 = TotalOO5 + OO5(jjqq11,jjqq31)
            TotalOO6 = TotalOO6 + OO6(jjqq11,jjqq31)
            TotalNO5 = TotalNO5 + NO5(jjqq11,jjqq31)
            TotalNO6 = TotalNO6 + NO6(jjqq11,jjqq31)
          End if
          '$$$$$$IPl
        End if
      Next qq2
    Next qq1

    If  (TotalNN5+TotalNN6+TotalOO5+TotalOO6+TotalNO5+TotalNO6 >0 And TotalNN4=0) Then
      T_MARGIN = T_MARGIN + STR_SHIFT

      els = obj.Assembly.Item(DANum(jj(1)+1)).ElSymbol
      ResultString = Trim(els)+Trim(Str(DANum(jj(1)+1)))
      For p=2 to k
        els = obj.Assembly.Item(DANum(jj(p)+1)).ElSymbol
        ResultString = ResultString + ", " +Trim(els)+ Trim(Str(DANum(jj(p)+1)))
      Next p
      Print MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6
      SConstVal=FStr(lg_K1(MetalAtom, Nam, Oac, TotalNN5, TotalNN6, TotalOO5, TotalOO6, TotalNO5, TotalNO6),10,2)
      ResultString ="LogK1 = "+LTrim(SConstVal)+"    [ "+Trim(ResultString) +" ]"
      NDATB.SetContent(ResultString)
      NDATB.SetBound(L_MARGIN, T_MARGIN, 2500, H_STRING)
    End if


    c = c+1
    If c<c0 Then
      goto begin
    End if


  T_MARGIN = T_MARGIN + STR_SHIFT

  If (OutputFormat = "CN" Or Total_NDA<=k) Then
    goto ends
  Else
    k=k+1
    goto Local_NDA
  End if

ends:
End Sub 'CreateComplexes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function lg_K1(metal As String, n_Nam As Integer, n_Oac As Integer, n_NN5 As Integer, n_NN6 As Integer, n_OO5 As Integer, n_OO6 As Integer, n_NO5 As Integer, n_NO6 As Integer) As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Huge body of equations ....                                            '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Check
  If (n_Nam > 1 Or n_Oac > 1 Or n_OO5 > 1) Then
    ErrOut("Only one ligand may be attached to the metal!") : Stop
  End if


'Act

  lg_K1= 0.0

  select case metal


    case "Ba_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.79 + 1.34*n_NN5 - 1.42*n_NN6 - 0.92*n_OO6 + 0.76*n_NO5 - 0.39*n_NO6
      End if
      If (not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.01 + 1.89*n_NN5 + 0.00*n_NN6 - 1.05*n_OO6 + 0.63*n_NO5 - 0.55*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.88
      End if
      If n_OO5 = 1 Then
        lg_K1= 0.60
      End if



    case "Ca_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.03 + 1.53*n_NN5 - 0.14*n_NN6 - 1.01*n_OO6 + 1.62*n_NO5 - 0.16*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.01 + 3.44*n_NN5 + 0.00*n_NN6 - 1.42*n_OO6 + 1.01*n_NO5 - 0.73*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.45
      End if
      If n_OO5 = 1 Then
        lg_K1= 3.00
      End if



    case "Cd_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.99 + 2.21*n_NN5 + 1.74*n_NN6 + 0.57*n_OO6 + 2.37*n_NO5 + 0.76*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.94 + 3.05*n_NN5 + 1.45*n_NN6 + 0.61*n_OO6 + 2.33*n_NO5 + 0.57*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 2.66
      End if
      If n_Oac = 1 Then
        lg_K1= 1.36
      End if
      If n_OO5 = 1 Then
        lg_K1= 2.68
      End if



    case "Ce_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.89 + 0.78*n_NN5 + 0.00*n_NN6 + 0.13*n_OO6 + 2.04*n_NO5 + 0.85*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.58
      End if
      If n_OO5 = 1 Then
        lg_K1= 4.90
      End if



    case "Co_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.83 + 2.41*n_NN5 + 2.31*n_NN6 - 0.44*n_OO6 + 2.09*n_NO5 + 0.97*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.48 + 2.68*n_NN5 + 1.84*n_NN6 - 0.09*n_OO6 + 2.33*n_NO5 + 1.01*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 2.10
      End if
      If n_Oac = 1 Then
        lg_K1= 1.35
      End if
      If n_OO5 = 1 Then
        lg_K1= 4.70
      End if



    case "Cr_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 6.83 + 0.00*n_NN5 + 0.00*n_NN6 + 0.23*n_OO6 + 1.47*n_NO5 + 2.92*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 5.78
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.34
      End if



    case "Cu_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 4.72 + 3.77*n_NN5 + 2.93*n_NN6 - 0.39*n_OO6 + 2.61*n_NO5 + 1.54*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 4.72 + 3.73*n_NN5 + 2.90*n_NN6 - 0.39*n_OO6 + 2.63*n_NO5 + 1.55*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 4.18
      End if
      If n_Oac = 1 Then
        lg_K1= 2.41
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.67
      End if



    case "Dy_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 3.15 + 1.23*n_NN5 + 0.00*n_NN6 + 0.37*n_OO6 + 2.21*n_NO5 + 1.49*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.86
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.72
      End if



    case "Er_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.98 + 0.67*n_NN5 + 0.00*n_NN6 + 0.70*n_OO6 + 2.39*n_NO5 + 1.75*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.70
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.85
      End if



    case "Eu_3"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.31 + 1.15*n_NN5 + 0.00*n_NN6 + 2.14*n_OO6 + 2.68*n_NO5 + 1.47*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.72
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.40
      End if



    case "Gd_3"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.39 + 3.19*n_NN5 - 2.76*n_NN6 + 2.08*n_OO6 + 2.49*n_NO5 + 0.95*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.55 + 1.45*n_NN5 + 0.00*n_NN6 + 1.92*n_OO6 + 2.52*n_NO5 + 1.36*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.45
      End if
      If n_Oac = 1 Then
        lg_K1= 2.38
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.56
      End if



    case "Hg_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 9.04 + 4.69*n_NN5 + 0.94*n_NN6 + 0.00*n_OO6 + 1.48*n_NO5 - 0.38*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 9.04 + 4.69*n_NN5 + 0.00*n_NN6 + 0.00*n_OO6 + 1.48*n_NO5 - 0.38*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 8.80
      End if
      If n_Oac = 1 Then
        lg_K1= 3.61
      End if
      If n_OO5 = 1 Then
        lg_K1= 7.25
      End if



    case "Ho_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.88 + 0.54*n_NN5 + 0.00*n_NN6 + 0.50*n_OO6 + 2.45*n_NO5 + 1.77*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.54
      End if
      If n_OO5 = 1 Then
        lg_K1= 0.00
      End if



    case "La_3"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.60 + 1.83*n_NN5 - 1.12*n_NN6 - 0.24*n_OO6 + 2.10*n_NO5 + 0.89*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.61 + 1.16*n_NN5 + 0.00*n_NN6 - 0.13*n_OO6 + 2.16*n_NO5 + 1.04*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.20
      End if
      If n_Oac = 1 Then
        lg_K1= 2.67
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.20
      End if



    case "Lu_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.97 + 0.64*n_NN5 + 0.00*n_NN6 + 0.39*n_OO6 + 2.55*n_NO5 + 1.87*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.70
      End if
      If n_Oac = 1 Then
        lg_K1= 2.73
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.28
      End if



    case "Mg_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.78 + 1.26*n_NN5 - 0.69*n_NN6 - 0.85*n_OO6 + 1.16*n_NO5 + 0.05*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.11 + 3.11*n_NN5 + 0.00*n_NN6 - 1.13*n_OO6 + 0.82*n_NO5 - 0.39*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.20
      End if
      If n_Oac = 1 Then
        lg_K1= 2.53
      End if
      If n_OO5 = 1 Then
        lg_K1= 2.18
      End if



    case "Mn_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 0.83 + 1.67*n_NN5 + 1.15*n_NN6 + 0.00*n_OO6 + 2.48*n_NO5 + 0.71*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 0.98 + 1.62*n_NN5 + 0.79*n_NN6 + 0.00*n_OO6 + 2.31*n_NO5 + 0.84*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 1.27
      End if
      If n_Oac = 1 Then
        lg_K1= 1.28
      End if
      If n_OO5 = 1 Then
        lg_K1= 3.90
      End if



    case "Nd_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.26 + 1.13*n_NN5 + 0.00*n_NN6 + 1.81*n_OO6 + 2.66*n_NO5 + 1.46*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.66
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.45
      End if



    case "Ni_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.91 + 2.87*n_NN5 + 2.41*n_NN6 - 0.69*n_OO6 + 2.78*n_NO5 + 1.31*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.86 + 3.55*n_NN5 + 2.58*n_NN6 - 0.68*n_OO6 + 2.71*n_NO5 + 1.23*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 2.78
      End if
      If n_Oac = 1 Then
        lg_K1= 1.71
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.30
      End if



    case "Pb_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.71 + 2.28*n_NN5 + 1.21*n_NN6 + 0.39*n_OO6 + 2.90*n_NO5 + 0.26*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.56 + 2.35*n_NN5 + 0.00*n_NN6 + 0.54*n_OO6 + 3.06*n_NO5 + 0.13*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 1.55
      End if
      If n_Oac = 1 Then
        lg_K1= 2.73
      End if
      If n_OO5 = 1 Then
        lg_K1= 3.32
      End if



    case "Pr_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.49 + 1.07*n_NN5 + 0.00*n_NN6 + 1.51*n_OO6 + 2.50*n_NO5 + 1.21*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.76
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.29
      End if



    case "Sm_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.61 + 1.76*n_NN5 + 0.00*n_NN6 + 1.78*n_OO6 + 2.53*n_NO5 + 1.20*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.90
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.61
      End if



    case "Sr_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 1.83 + 1.98*n_NN5 - 1.32*n_NN6 - 1.30*n_OO6 + 0.92*n_NO5 - 0.60*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.06 + 2.39*n_NN5 + 0.00*n_NN6 - 1.40*n_OO6 + 0.80*n_NO5 - 0.73*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.38
      End if
      If n_OO5 = 1 Then
        lg_K1= 1.40
      End if



    case "Tb_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 3.05 + 1.09*n_NN5 + 0.00*n_NN6 + 0.41*n_OO6 + 2.23*n_NO5 + 1.59*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.84
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.50
      End if



    case "Th_4"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 6.05 + 0.00*n_NN5 + 0.00*n_NN6 + 0.00*n_OO6 + 2.13*n_NO5 + 1.05*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 3.88
      End if
      If n_OO5 = 1 Then
        lg_K1= 8.81
      End if



    case "Tm_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 3.01 + 0.70*n_NN5 + 0.00*n_NN6 + 0.38*n_OO6 + 2.48*n_NO5 + 1.73*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.54
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.60
      End if



    case "UO2_2"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 5.52 + 1.75*n_NN5 + 0.00*n_NN6 + 0.00*n_OO6 + 1.00*n_NO5 + 0.00*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 2.00
      End if
      If n_Oac = 1 Then
        lg_K1= 4.16
      End if
      If n_OO5 = 1 Then
        lg_K1= 4.48
      End if



    case "VO_2"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 4.28 + 3.76*n_NN5 + 0.00*n_NN6 + 0.00*n_OO6 + 2.59*n_NO5 + 0.91*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 3.97
      End if
      If n_OO5 = 1 Then
        lg_K1= 6.45
      End if



    case "Y_3"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.36 + 2.77*n_NN5 - 0.99*n_NN6 + 2.24*n_OO6 + 2.52*n_NO5 + 1.01*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.47 + 0.70*n_NN5 + 0.00*n_NN6 + 2.13*n_OO6 + 2.67*n_NO5 + 1.57*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.40
      End if
      If n_Oac = 1 Then
        lg_K1= 2.97
      End if
      If n_OO5 = 1 Then
        lg_K1= 5.46
      End if



    case "Yb_3"
      If (n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.88 + 0.72*n_NN5 + 0.00*n_NN6 + 0.47*n_OO6 + 2.55*n_NO5 + 1.81*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 0.00
      End if
      If n_Oac = 1 Then
        lg_K1= 2.48
      End if
      If n_OO5 = 1 Then
        lg_K1= 7.30
      End if



    case "Zn_2"
      If (MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.12 + 2.63*n_NN5 + 2.30*n_NN6 + 0.51*n_OO6 + 2.69*n_NO5 + 1.25*n_NO6
      End if
      If (Not MC And n_Nam = 0 And n_Oac=0 And n_OO5=0) Then
        lg_K1 = 2.15 + 3.07*n_NN5 + 2.20*n_NN6 + 0.48*n_OO6 + 2.55*n_NO5 + 1.18*n_NO6
      End if
      If n_Nam = 1 Then
        lg_K1= 2.35
      End if
      If n_Oac = 1 Then
        lg_K1= 1.31
      End if
      If n_OO5 = 1 Then
        lg_K1= 4.90
      End if



    case Else
      ErrOut("Unknown metal ion")
      Stop

  End select

End Function 'lg_K1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function LabelDiagram(byval labtype As String,diag1 As Object) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim struc As Object, nl As Integer
  LabelDiagram = false
with ActiveDocument.ActivePage.Diagrams
  struc=Assemblies.AddFromCS(diag1).Structures.Item(1)
  'supply atomic labels
  nl=SetAtomLabels(labtype,struc)
  'show labelled diagram
  RefreshDiagram(diag1,struc)
End with
  LabelDiagram = true
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SetAtomLabels(byval labtype As String,struc As Object) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sets the atomic labels through SetName                                 '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim nat As Integer, i As Integer, nl As Integer, x,y,z As Double
Dim l As String, at As Object
with struc.Assembly
    nat=.Count : nl=0
    For i=1 to nat
      at=.Item(i)
      select case labtype
        case "L"
                at.SetName(Str(i))
        case "U"
                at.SetName("")
        case "V"
                If (at.GetElNumber>1) Then
                  at.SetName(Str(i))
                Else
                  at.SetName("")
                End if

        case "E"
                If (at.GetElNumber>1) And (at.GetElNumber<>6) Then
                  at.SetName(Str(i))
                Else
                  at.SetName("")
                End if

    End select
    Next i
End with
SetAtomLabels=nat
End Function 'SetAtomLabels
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFirstActiveStructure(struct as  object) as  boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Get 1st structure from active page of active CS document              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim diag,asm As Object,OK As Boolean
  GetFirstActiveStructure=False
  with ActiveDocument.ActivePage.Diagrams
    If .Count<1 Then Exit Function
    diag=.Item(1)
    asm=Assemblies.AddFromCS(diag)
    If asm=NULL Then Exit Function
    struct=asm.Structures.Item(1)
    If struct=NULL Then Exit Function
    OK=LabelDiagram("E",.Item(1))
    GetFirstActiveStructure=True
  End with
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RefreshDiagram(diag As Object,strmol As Object)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim l,t,w,h,w1,h1 As Integer
  diag.GetBound(l,t,w,h)
  diag.Depict(strmol)
  diag.GetBound(w,h,w1,h1)
  diag.SetBound(l,t,w1,h1)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ErrOut(ByVal strg As String)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Error message Function                                                  '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Tmp As Integer
  Tmp = MessageBox(strg, "FATAL ERROR", MBB_OK + MBI_Stop)
End Sub 'ErrOut




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub WarnOut(ByVal strg As String)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Warning message Function                                                '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Tmp As Integer
  Tmp = MessageBox(strg + Chr(13) + "Continue?", "Warning!", MBB_YESNO + MBI_EXCLAMATION)
  If Tmp = MBR_NO Then Stop
End Sub 'WarnOut