Attribute VB_Name = "topAcadObj"
'+===========================================================================
'| MODULE: DGTopAcad.bas
'+===========================================================================
'¦
'¦ Purpose: Bind to the AcadApplication
'¦          of the Top AutoCAD Window
'¦
'¦ Un merci special a Albert Szilvasy, auteur de AcadUnsupp
'¦
'¦
'¦ Written by:
'¦          Denis Gagne - 1999-08-09
'+===========================================================================


Private Const GW_HWNDNEXT = 2

Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Private acads As New Collection
'Private hMainAcad As Long

Public Function getTopAcad() As Object
Dim oAcad As Object
Dim help As Object
Dim topAcadCaption As String

  'hMainAcad = 0
  'topAcadCaption = FindTopAcadWindow
  hMainAcad = FindTopAcadWindow
  
  On Error Resume Next
  
  If Not hMainAcad = 0 Then
      Err.Clear
      
      'Trouve la session acad qui correspond
      'à la fenêtre la plus haute
      Do
          'Cherche la prochaine session inscrite dans la ROT
          
          Set oAcad = GetObject(, "AutoCAD.Application")
          
          'Charge Acadunsupp
          Set help = oAcad.GetInterfaceObject("AcadUnsupp.Application.1")
          If Err <> 0 Then
            'Enregistre AcadUnsup à la première utilisation
            oAcad.Application.LoadArx (App.Path & "libdll\acadunsupp.arx")
            Set help = oAcad.GetInterfaceObject("AcadUnsupp.Application.1")
          End If
          
          'Vérifie si le handle correspond
          'avec celui de la fenêtre la plus élevée
          'si oui cesse la recherche
          'sinon passe à la suivante
          If hMainAcad = help.HwndOfFrame Then
            Exit Do
          Else
             'Efface cete session AutoCAD de la ROT
            help.RevokeAutoCAD
            acads.Add help
          End If
      
      Loop Until oAcad Is Nothing
      
  Else
    Dim acadPath As String
    Set oAcad = GetObject(, "AutoCAD.Application")
    'Si aucune session AutoCAD n'est ouverte
    If oAcad Is Nothing Then
      'acadPath = QueryValue(HKEY_CLASSES_ROOT, "AutoCAD.Drawing.14\protocol\StdFileEditing\server", "") 'Call sub
      'If acadPath <> "" Then ChDir VBA.Left(acadPath, _
        InStr(acadPath, "\ACAD.EXE") - 1)
      Set oAcad = CreateObject("AutoCAD.Application")
      oAcad.Visible = True
    End If
  End If
  
  Set getTopAcad = oAcad
  registerAcads
  
End Function

Private Function FindTopAcadWindow() As Long 'String
 
Dim hWndTmp As Long
Dim nRet As Integer
Dim strTmp As String

  'Commençant par la fenêtre la plus élevée
  'poursuit la recherche jusqu'à ce qu'on trouve
  'la 1ère fenêtre AutoCAD
  hWndTmp = GetForegroundWindow
  
  Do Until hWndTmp = 0
   strTmp = Space$(256)
   nRet = GetClassName(hWndTmp, strTmp, Len(strTmp))
   If nRet Then
    'Vérifions si la classe correspond
    If InStr(strTmp, "Afx:400000:8") Then
     nRet = GetWindowText(hWndTmp, strTmp, Len(strTmp))
     strTmp = UCase$(VBA.Left$(strTmp, nRet))
     'Et maintenant le titre
     If InStr(strTmp, "AUTOCAD") Then
      'FindTopAcadWindow = strTmp
      FindTopAcadWindow = hWndTmp
      Exit Do
     End If
    End If
   End If
   'Passe à la fenêtre suivante
   hWndTmp = GetNextWindow(hWndTmp, GW_HWNDNEXT)
  Loop
End Function

Public Sub registerAcads()
Dim hlp As Object
  On Error Resume Next
    'Enregistre les sessions d'AutoCAD pour que
    'd'autres applications puissent s'y connecter
  If Not acads Is Nothing Then
    For Each hlp In acads
      hlp.RegisterAutoCAD
    Next hlp
  End If
  Set acads = Nothing
End Sub

Public Sub main()
  Debug.Print getTopAcad.Caption
End Sub