' **********************************************************************
' Author:
' Bruno Ryf © by ryfCAD, www.ryfCAD.ch

' Date:
' 06.02.2006

' Revision:
' 

' Version:
' 1.0.1
' 
'
' Funktion:
' Erstellt einen Text mit Pfad und Zeichnungsnamen 
' **********************************************************************

' general comment
'==============================

' Die VBS-Funktion wird wie folgt aus AutoCAD LT heraus geladen:
' Menüeintrag POP oder Toolbar ^C^C^P_setenv;FileName;$M=$(substr,"""""""x""""""",1,1)$(getvar,dwgname)$(substr,"""""""x""""""",1,1);_ai_startapp;<Pfad>/Info2DWG.vbs

' declare Variables
'==============================

Dim logFilePath         'Path of Log-File
Dim logFileName         'Name AND Path of Log-File
Dim dwgFilePath         'Path of Drawing-File
Dim dwgFileName         'Name only of Drawing-File
Dim lang		'Language of AutoCAD LT
Dim ACLT                'Switch if aclt.exe is running  1 = yes / 0 = no
Dim Check               'Flag für Prüfung
Check = -1


' main body
'==============================

CheckAclt

If Check = 1 Then
  WriteLogFile1
  ReadLogFile1
  DelLogFile
  SetInfo
End If

' sub functions
'==============================

Function CheckAclt
' Checkt, ob AutoCAD LT aktiviert ist

  Set objWMI = GetObject("winmgmts:")
  wql = "select * from Win32_Process where name='aclt.exe'"
  Set result = objWMI.ExecQuery(wql)
  Select Case result.Count
    Case 0
      Check = -1
      MsgBox "Please start AutoCAD LT!", 48, "Info2DWG"
    Case 1
      Check = 1
      Call GreateLogFile
      Call CheckAcVer
      Call DelLogFile
    Case Else
      Check = -1
      MsgBox result.Count & " AutoCAD LT are running!" & vbCr & "Please have only 1 AutoCAD LT running!", 48, "Info2DWG"
  End Select
End Function

'==============================

Function DelLogFile
' Löscht das allenfalls vorhandene Logfile von AutoCAD LT

 Dim objfs
 Set objfs = CreateObject("Scripting.FileSystemObject")
 If (objfs.FileExists(logFileName)) Then
   objfs.DeleteFile logFileName, True
   Set objfs = Nothing
 End If
End Function

'==============================

Function GreateLogFile
' Sendet Befehle an AutoCAD LT zur Erstellung eines Logfiles

  Set WshShell = WScript.CreateObject("WScript.Shell")
  WshShell.AppActivate "AutoCAD LT"
  WScript.Sleep 100
  WshShell.SendKeys "_.logfilemode"
  WScript.Sleep 100
  WshShell.SendKeys "~"
  WScript.Sleep 100
  WshShell.SendKeys "1"
  WScript.Sleep 100
  WshShell.SendKeys "~"
  WScript.Sleep 100
  WshShell.SendKeys "_.logfilemode"
  WScript.Sleep 100
  WshShell.SendKeys "~"
  WScript.Sleep 100
  WshShell.SendKeys "0"
  WScript.Sleep 100
  WshShell.SendKeys "~"
  WScript.Sleep 100
End Function

'==============================

Function CheckAcVer
' Checkt die aktuelle AutoCAD LT- Version und Sprache und ermittelt dessen Logfilepfad

  Dim str
  Dim slen
  Dim WshShell  
  Dim localArray
  'FileName aus der Registry auslesen und so die aktuelle Sprache ermitteln
  dwgFileName = "none"
  Set WshShell = WScript.CreateObject("WScript.Shell")

 'AutoCAD LT 2004
  On Error Resume Next
  dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:407\FixedProfile\General\FileName")
  If Not dwgFileName = "none" Then
    lang = "DEU"
    WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:407\FixedProfile\General\FileName"
    logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:407\Profiles\<<Unbenanntes Profil>>\Editor Configuration\LogFilePath")
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:40C\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "FRA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:40C\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:40C\Profiles\<<profil sans nom>>\Editor Configuration\LogFilePath")
    End If
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:410\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "ITA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:410\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R9\ACLT-201:410\Profiles\<<profilo senza nome>>\Editor Configuration\LogFilePath")
    End If
  End If
   
 'AutoCAD LT 2005
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:407\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "DEU"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:407\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:407\Profiles\<<Unbenanntes Profil>>\Editor Configuration\LogFilePath")
    End If
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:40C\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "FRA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:40C\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:40C\Profiles\<<profil sans nom>>\Editor Configuration\LogFilePath")
    End If
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:410\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "ITA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:410\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R10\ACLT-301:410\Profiles\<<profilo senza nome>>\Editor Configuration\LogFilePath")
    End If
  End If
  
  'AutoCAD LT 2006
  If dwgFileName = "none" Then
    On Error Resume Next
      dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:407\FixedProfile\General\FileName")
      If Not dwgFileName = "none" Then
      lang = "DEU"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:407\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:407\Profiles\<<Unbenanntes Profil>>\Editor Configuration\LogFilePath")
    End If
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:40C\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "FRA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:40C\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:40C\Profiles\<<profil sans nom>>\Editor Configuration\LogFilePath")
    End If
  End If
  If dwgFileName = "none" Then
    On Error Resume Next
    dwgFileName = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:410\FixedProfile\General\FileName")
    If Not dwgFileName = "none" Then
      lang = "ITA"
      WshShell.RegDelete "HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:410\FixedProfile\General\FileName"
      logFilePath = WshShell.RegRead ("HKCU\Software\Autodesk\AutoCAD LT\R11\ACLT-4001:410\Profiles\<<profilo senza nome>>\Editor Configuration\LogFilePath")
    End If
  End If
  
  'Pfad und Dateiname des AutoCAD LT- Logfiles ermitteln
  localArray = Split (dwgFileName, ".")
  slen = Len(localArray(0))
  Set objfs = CreateObject("Scripting.FileSystemObject")
  Set objfolder = objfs.GetFolder (logFilePath)
  Set colfiles = objfolder.Files
  For Each objfile In colfiles
    str = Left (objfile.name, slen)
    If str = localArray(0) Then 
      logFileName = logFilePath & "\" & objfile.name
      logFileName = Replace(logFileName,"/","\")
    End If
  Next
End Function

'==============================

Function WriteLogFile1
' Sendet Befehle an AutoCAD LT zur Erstellung eines Logfiles mit Angaben über den Pfad der aktuellen Zeichnung

 Set WshShell = WScript.CreateObject("WScript.Shell")
 WshShell.AppActivate "AutoCAD LT"
 WScript.Sleep 100
 WshShell.SendKeys "_.logfilemode"
 WScript.Sleep 100
 WshShell.SendKeys "~"
 WScript.Sleep 100
 WshShell.SendKeys "1"
 WScript.Sleep 100
 WshShell.SendKeys "~"
 WScript.Sleep 100
 WshShell.SendKeys "_.dwgprefix"
 WScript.Sleep 100
 WshShell.SendKeys "~"
 WScript.Sleep 100
 WshShell.SendKeys "_.logfilemode"
 WScript.Sleep 100
 WshShell.SendKeys "~"
 WScript.Sleep 100
 WshShell.SendKeys "0"
 WScript.Sleep 100
 WshShell.SendKeys "~"
End Function

'==============================

Function ReadLogFile1
' Liest die erste Logdatei und ermittelt den Pfad der aktuellen Zeichnung

   Const ForReading = 1
   Dim fso, file, l, s, ss, localArray, localArray2,strArray, str, i, sl
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set file = fso.OpenTextFile(logFileName, ForReading, False)
   Do While file.AtEndOfStream <> True
      l = file.ReadLine
      s = Left (l, 13)
      If s = "DWGPREFIX = " & Chr(34) Then
         strArray = Split (l, Chr(34))
         dwgFilePath = strArray(1)
      End If
   Loop
   file.Close
   Set file = Nothing
End Function

'==============================

Function SetInfo
' Schreibt die Info in die Zeichnung

  Set WshShell = WScript.CreateObject("WScript.Shell")
  WshShell.AppActivate "AutoCAD LT"
  WScript.Sleep 500
  WshShell.SendKeys "_.text"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "0,0,0"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys dwgFilePath & dwgFileName
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "_.zoom"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "_e"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "_.move"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "_l"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500
  WshShell.SendKeys "0,0,0"
  WScript.Sleep 500
  WshShell.SendKeys "~"
  WScript.Sleep 500 
End Function