Check Instances of AutoCad for Open Documents

[BlackBox]

I just remembered you're attempting to write an Application outside of AutoCAD... The code being referenced (from the developer help) assumes you are coding a plug-in to load/run within AutoCAD.

[beerboy]

This is a File Manager Applicatio which clients reference an index of documents stored in an Access mdb file. The app allows them to check out, check in or copy files. If a client attempts to check in a file that is open in Autocad he/she receives a message from the app to save and close the file first. This only checks to see if the file is open. It does nothing inside of Autocad or to the file.

Here is the VB6 code for this function.

Public Function AcadLink() As Boolean
  Dim i As Integer
  Dim DwgName As String
  Dim hWndMain As Long
  Dim appverfile As String
  Dim lstItem As String
  Dim strappver As String
 
  AcadLink = False
  On Error GoTo nocad
  Set AcadApp = GetObject(, "AutoCAD.Application")
'  Debug.Print AcadApp.Name
'  Debug.Print AcadApp.FullName
'  Debug.Print AcadApp.hWnd
'  Debug.Print AcadApp.Caption
'  MsgBox ("*" & AcadApp.Caption & "*"), vbOKOnly
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  appverfile = strAppPath & "ClientAutoCadVersion.rpt"
  If bFileExists(appverfile) Then
    Open appverfile For Input As #filenum
    Do
      Input #filenum, lstItem
      If UCase(lstItem) = UCase(Left(AcadApp.Caption, Len(lstItem))) Then
        strappver = Left(AcadApp.Caption, Len(lstItem))
      End If
    Loop Until EOF(filenum)
    Close #filenum
    DoEvents
  End If
 
  If Len(strappver) = 0 Then
    appverfile = "\\networkplace\ClientAutoCadVersion.rpt"
    If bFileExists(appverfile) Then
      strappver = Left(AcadApp.Caption, InStr(1, AcadApp.Caption, "[") - 4)
      Open appverfile For Append As #filenum
      Print #filenum, strappver
      Close #filenum
      DoEvents
      filea = strAppPath & "ClientAutoCadVersion.rpt"
      fileb = "\\networkplace\ClientAutoCadVersion.rpt"
      FileUpdate
      DoEvents
    End If
  End If
 
  appverfile = strAppPath & "ClientAutoCadVersion.rpt"
  If bFileExists(appverfile) Then
    Open appverfile For Input As #filenum
    Do
      Input #filenum, lstItem
      hWndMain = FindWindow(vbNullString, lstItem & " - [" & lstCitem & ".dwg]")
      If hWndMain > 0 Then
        AcadLink = True
        Close #filenum
        DoEvents
        GoTo nocad
      End If
    Loop Until EOF(filenum)
  End If
 
  For i = 0 To AcadApp.Documents.Count - 1
    DwgName = Left(Right(AcadApp.Documents(i).Name, Len(lstCitem) + 4), Len(lstCitem))
    If lstCitem = DwgName Then
      AcadLink = True
      Exit For
    End If
  Next i
nocad:
End Function