Hi ,
habe den Code maybe someboddy need`s
was macht er :
er prüft ob eine Instanz von autocad geöffnet ist !
wenn eine instanz geöffnet ist , öffnet er die zeichnung d:\tb\A10-25a_Blech_SII.dwg
wenn nicht öffnet er eine instanz von autocad und die zeichnung
d:\tb\A10-25a_Blech_SII.dwg
s.h. function applactivate
der code funktioniert mit jedem programm , es sollte nur der name in der function autocad_load eingetragen werden !
bei fragen sendet mir eine mail
danke http://vb-tec.de
Private Declare Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetParent Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextA Lib "user32" ( _
ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function IsIconic Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Sub SetForegroundWindow Lib "user32" ( _
ByVal hwnd As Long)
Private Declare Sub ShowWindow Lib "user32" ( _
ByVal hwnd As Long, ByVal nCmdShow As Long)
Private Declare Function ShellExecuteA Lib "shell32.dll" ( _
ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long _
) As Long
Public Sub autocad_Load()
PrevActivate ("autocad 2002")
End Sub
Function ShellExec( _
ByVal PATH As String, _
Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, _
Optional ByVal Operation As String = "open" _
) As Boolean
ShellExec = ( _
ShellExecuteA(0&, Operation, PATH, _
vbNullString, vbNullString, WindowStyle) > 32)
End Function
Sub PrevActivate(Optional ByVal Title As String)
'Caption merken und maskieren:
If Len(Title) = 0 Then _
Title = Screen.ActiveForm.Caption
'Andere Instanz aktivieren:
ApplActivate Title
End
End Sub
Sub ApplActivate(ByVal Appl As Variant)
Const SW_RESTORE = 9
'Ggf. Handle zu Caption suchen:
If Not IsNumeric(Appl) Then _
Appl = ApplHandle(Appl)
'Ggf. "Wiederherstellen":
If IsIconic(Appl) Then _
ShowWindow Appl, SW_RESTORE
'Anwendung in den Vordergrund bringen:
If Appl = 0 Then
RetVal = Shell("c:\Programme\AutoCAD 2002\acad.exe", vbMaximizedFocus)
ShellExec "d:\tb\A10-25a_Blech_SII.dwg"
Else
ShellExec "d:\tb\A10-25a_Blech_SII.dwg"
End If
SetForegroundWindow Appl
End Sub
Function ApplHandle(ByVal Caption As String) As Long
Dim vClass As Variant
'VB-Applikationen/Klassen bevorzugen:
For Each vClass In Array( _
"ThunderRT5MDIForm", "ThunderRT6MDIForm", _
"ThunderRT5Form", "ThunderRT6Form", _
vbNullString)
'Applikation/Klasse checken:
ApplHandle = GetHandle(vClass, Caption)
If ApplHandle Then Exit Function
Next vClass
End Function
Function GetHandle( _
ByVal Class As String, ByVal Caption As String _
) As Long
Const GW_HWNDNEXT = 2
Dim Buffer As String
Dim Length As Long
'Auf exakten Treffer checken:
GetHandle = FindWindowA(Class, Caption)
If GetHandle Then Exit Function
'Alle Klassen-Windows durchlaufen:
Caption = UCase$(Trim$(Caption))
GetHandle = FindWindowA(Class, vbNullString)
Do While GetHandle
'Nur Top-Windows berücksichtigen:
If GetParent(GetHandle) = 0 Then
'Caption holen:
Buffer = Space$(255)
Length = GetWindowTextA(GetHandle, Buffer, 255)
Buffer = UCase$(Left$(Buffer, Length))
'Exakter Vergleich:
If Buffer = Caption Then Exit Do
'MDI-Form berücksichtigen:
If Buffer Like Caption & " - *" Then Exit Do
End If
GetHandle = GetWindow(GetHandle, GW_HWNDNEXT)
Loop
End Function
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
Skripte schlagen fehl und öffnen immer eine neue Instanz von Auto Cad !
