---

Hallo liebe Leute,

ich brauche da einen Spezialisten 

Hab einen Makro der die .dwt Datei als .dwg in AutoCAD öffnet. Hier habt ihr den Code:

Option Explicit
Public ThisDrawing As AcadDocument
Sub open_dwt()
Set ThisDrawing = AutoCAD.Documents.Add(ThisWorkbook.path & "\FLW40_FLG40.dwt")
ThisDrawing.Activate
End Sub

Das Makro soll nur wenn der AutoCAD offen ist laufen. Wenn AutoCAD zu ist soll eine Meldung kommen "AutoCAD zuerst öffnen". Hab da was schon gemacht aber ich kriege immer einen Laufzeit Fehler 462

Dabei hab ich diese Zusatz Makro benutzt:

Function IsAppRunning(ByVal sAppName) As Boolean
  Dim oApp As Object
  On Error Resume Next
  Set oApp = GetObject(, sAppName)
  If Not oApp Is Nothing Then
      Set oApp = Nothing
      IsAppRunning = True
  End If
End Function

und:

Sub runsub(control As IRibbonControl)
If Not IsAppRunning("AutoCAD.Application") Then
MsgBox "AutoCAD zuerst öffnen"
Else
Call open_dwt
End Sub

Kann mich jemand bei deinem Problem unterstützen???

Freue mich auf Zuschriften
Schöne Grüße
Alex

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Alex,

hier ein Auszug von einem Programmcode aus Excel. Der sollte helfen.

Code:

---

' AutoCAD Application as Objekt für LateBinding
Dim AcadApp As Object
' aktuelle AutoCAD DWG
Dim AcadDoc As Object

Sub DemoZoomCenter()
    ZoomCenter 100, 100
End Sub
Sub DemoZoomWindow()
    ZoomWindow 90, 90, 150, 150
End Sub
Sub DemoRefreshLayers()
    MapUpdateMap
End Sub

Sub DemoLayerOnOff()
    LayerOnOff ("WA - Leitung Anschlussleitung")
End Sub
Public Sub LayerOnOff(Layername As String)
    ' Ist AutoCAD geladen?
    If Not ExistAutoCAD Then
        Exit Sub
    End If

    AcadApp.ActiveDocument.SendCommand ("MeLayersRefresh " & Layername & vbCrLf)
End Sub

Public Function ExistAutoCAD() As Boolean
   
    ExistAutoCAD = False
   
    ' Fehlerbehandlung
    On Error Resume Next

    ' Versuche AutoCAD im Speicher zu finden
    Set AcadApp = GetObject(, "AutoCAD.Application")

    ' Wenn AutoCAD gefunden wurde ist der Fehler 0
    If Err.Number = 0 Then
      Set AcadDoc = AcadApp.ActiveDocument
      ExistAutoCAD = True
    End If
   
    'Fehlerbehandlung zurücksetzen
    On Error GoTo 0
End Function

Sub MapUpdateMap()
    ' Ist AutoCAD geladen?
    If Not ExistAutoCAD Then
        Exit Sub
    End If

    AcadApp.ActiveDocument.SendCommand ("MapUpdateMap" & vbCrLf)
End Sub

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

    Option Explicit
   
    Private Declare Function OpenProcess Lib "kernel32" ( _
        ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
       
    Private Declare Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As Long) As Long
   
    Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
      lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
   
    Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
        ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
   
    Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
        ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
   
    Private Const PROCESS_VM_READ = &H10
    Private Const PROCESS_QUERY_INFORMATION = &H400
   
    Private Function IsProcessRunning(ByVal sProcess As String) As Boolean
        Const MAX_PATH As Long = 260
        Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
        Dim sName As String
       
        sProcess = UCase$(sProcess)
       
        ReDim lProcesses(1023) As Long
        If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
            For N = 0 To (lRet \ 4) - 1
                hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
                If hProcess Then
                    ReDim lModules(1023)
                    If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
                        sName = String$(MAX_PATH, vbNullChar)
                        GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
                        sName = Left$(sName, InStr(sName, vbNullChar) - 1)
                        If Len(sName) = Len(sProcess) Then
                            If sProcess = UCase$(sName) Then IsProcessRunning = True: Exit Function
                        End If
                    End If
                End If
                CloseHandle hProcess
            Next N
        End If
    End Function
   
    Private Sub Command1_Click()
        Debug.Print IsProcessRunning("acad.exe")
    End Sub

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP