Opstarten van een vba routine in thisdrawing (opgelost)

[willyver]

Omdat ik niet tevreden was over batch plot van autocad heb ik mijn eigen batch plot geschreven, puur alleen voor A3 of A4 tekeningen. En omdat ik eigenlijk alleen maar elektrotechnische schema's teken, wat betekent dat ik soms veel tekeningen aanpas op een dag, die over verschillende directory's verspreid staan. Daarom had ik een routine gemaakt die als ik een nieuwe tekening open vraagt of ik de tekening die ik wil sluiten opgeslagen moet worden in een excel-bestand en dit bestand kan ik dan later in mijn batch plot opvragen.
Dit werkte goed in autocad 2006 t/m 2011 onder XP. Maar sinds vorige week ben ik overgestapt op Windows 7 X64 en nu werkt het dus niet meer. Dit is de code en deze staat onder Autocad Objects in ThisDrawing :

Code Selecteer Uitklappen

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
  If CommandName = "OPEN" Or strCMD = "_OPEN" Then
    frm_keuzemenu.Show
  End If
End Sub

Heeft iemand een idee waarom dit nu niet meer werkt.

[EddyBeerke]

Zo te zien is dit niet alle code. Er staat nog code in een Form.

Wij gaan binnenkort ook overstappen naar Win7 x64.
Dus ik kan je vraag niet beantwoorden.

Wat je wel kunt doen is kijken waar het in de code fout gaat door vòòr "If CommandName = "OPEN" Or strCMD = "_OPEN" Then" een stop teken te plaatsen (dat doe je door in de kolom links van de code te klikken, er verscheind dan een stip).
Als je nu een tekening opent dan wordt de code geactiveerd zoals gebruikelijk maar zal stoppen bij de stip. Nu kun je met [F8] door de code heen gaan en kijken waar dat het mis gaat.

Als je dan hier wil posten wat er mis gaat dan kunne we je verder helpen.

[sschevers]

Wat Eddy al aangeeft  met het steppen van je code kom je het snelst achter. Heb je schrijfrechten op de locatie waar de excel sheet staat? In Win7 is er qua beveiliging nog wat veranderd tov Xp (UAC en dat soort zaken). Overigens staat in je vraag niet wat er precies fout gaat. Wordt in excel niet meer geschreven of wordt de code in helemaal niet meer gestart. Kun je de dvb posten dan kunnen we er naar kijken

groeten

stephan

[willyver]

Hartelijk dank voor de reacties tot zover en de reacties die gaan komen en even ter aanvulling het gedeelte dat zorgt voor het wegschrijven naar excel werkt.
Maar voor de geïnteresseerden, hier is de code, het is geen hoogstaande programeerkunst
maar het werkt:

Code Selecteer Uitklappen

Option Explicit
Dim var_row As Integer, var_Teknum As String
Dim var_error As String
'Excel
Dim excelApp As excel.Application
Dim WbkObj As Workbook, shtobj As Worksheet
Dim fFs
'==================================================================

'Excel openen
Private Sub excel_openen()
  On Error Resume Next
  Err.Clear
  Set excelApp = GetObject(, "Excel.Application")
  If Err <> 0 Then
    Err.Clear
    Set excelApp = CreateObject("Excel.Application")
    If Err <> 0 Then
      MsgBox "Excel kan niet gestart worden", vbExclamation
      End
    End If
  End If
  Set excelApp = GetObject(, "Excel.Application")
  Set fFs = CreateObject("Scripting.FileSystemObject")
  If fFs.FileExists("h:\plotlijst.xls") Then
    excel.Application.Visible = False
    excel.Application.Workbooks.Close
    excel.Application.Workbooks.Open ("h:\plotlijst.xls")
    Set shtobj = excel.Application.Worksheets(1)
  Else
    excel.Application.Visible = False
    excel.Application.DisplayAlerts = False
    excel.Application.SheetsInNewWorkbook = 1
    Set WbkObj = Workbooks.Add
    excel.Application.Sheets("Blad1").Select
    excel.Application.Sheets("Blad1").Name = "Plotlijst"
    With WbkObj
        .Title = "Plot"
        .Subject = "lijst"
        .SaveAs FileName:="h:\plotlijst.xls"
    End With
    Set shtobj = excel.Application.Worksheets(1)
  End If
End Sub

'Excel afsluiten
Private Sub excel_sluiten()
  On Error Resume Next
  Set excelApp = GetObject(, "Excel.Application")
  If Err <> 0 Then
    Err.Clear
    MsgBox "Geen Excel sessie open", vbExclamation
  Else
    excel.Application.DisplayAlerts = False
    excel.Application.ActiveWorkbook.SaveAs ("h:\plotlijst.xls")
    excel.Application.Workbooks.Close
    excel.Application.Quit
  End If
End Sub

Private Sub cmb_NoSave_Click()
  Call XxxOff
  frm_keuzemenu.Hide
End Sub

Private Sub cmb_Save_Click()
    Call XxxOff
    var_row = 1
    Call excel_openen
    Do While shtobj.Cells(var_row, 1) <> ""
      If shtobj.Cells(var_row, 1) = ThisDrawing.FullName Then 'Tekening in plotlijst?
        Call excel_sluiten
        frm_keuzemenu.Hide
        Exit Sub
      End If
      var_row = var_row + 1
    Loop
    If (var_row Mod 2) Then ' Kijken of kolom is even of oneven
        var_Teknum = ThisDrawing.FullName
        shtobj.Cells(var_row, 1) = ThisDrawing.FullName
        shtobj.Cells(var_row, 2) = ThisDrawing.Name
        shtobj.Cells(var_row, 3) = Time
        shtobj.Cells(var_row, 4) = Date
        'excel.Application.Cells(var_row, 2).FormulaR1C1 = "=right(rc[-1],15)" (bewaren niet weg gooien)
        excel.Application.Cells(var_row, 1).Font.color = vbRed
        excel.Application.Cells(var_row, 1).Font.Bold = True
    Else
         var_Teknum = ThisDrawing.FullName
        shtobj.Cells(var_row, 1) = ThisDrawing.FullName
        shtobj.Cells(var_row, 2) = ThisDrawing.Name
        shtobj.Cells(var_row, 3) = Time
        shtobj.Cells(var_row, 4) = Date
        'excel.Application.Cells(var_row, 2).FormulaR1C1 = "=right(rc[-1],15)" (bewaren niet weg gooien)
        excel.Application.Cells(var_row, 1).Font.color = vbBlue
        excel.Application.Cells(var_row, 1).Font.Bold = True
        excel.Application.ActiveWorkbook.Colors(34) = RGB(234, 234, 234)
        excel.Application.Rows(var_row).Select
          With Selection.Interior
            .ColorIndex = 34
            .Pattern = xlSolid
          End With
    End If
    Call excel_sluiten
    frm_keuzemenu.Hide
End Sub
Private Sub XxxOff()
  Dim BlockObj As Object
  Dim BlockObjAttributes
  Dim i As Integer, b As Integer, c As Integer
  Dim BlockName As String, BlockMatch As String, waarde As String
  Dim XxxOff As AcadSelectionSet
  Dim handle
  Set XxxOff = ThisDrawing.SelectionSets.Add("OFFX")
  XxxOff.Select acSelectionSetAll
  b = XxxOff.Count - 1
  c = 0
  Do While c <= b
   Set BlockObj = ThisDrawing.HandleToObject(XxxOff.Item(c).handle)
   If BlockObj.ObjectName = "AcDbBlockReference" Then
      BlockObjAttributes = BlockObj.GetAttributes
      For i = LBound(BlockObjAttributes) To UBound(BlockObjAttributes)
         waarde = BlockObjAttributes(i).TextString
         If waarde = "XXX" Then
           BlockObjAttributes(i).TextString = "   "
         End If
      Next i
   Else
      If BlockObj.ObjectName = "AcDbText" Then
         waarde = BlockObj.TextString
         If waarde = "XXX" Then
           BlockObj.TextString = "   "
         End If
      Else
         'waarde = TextString
         'If waarde = "XXX" Then
         '   TextString = "   "
         ' End If
      End If
   End If
   c = c + 1
  Loop
  ThisDrawing.SelectionSets.Item("OFFX").Delete
End Sub

Ik had het al geprobeerd met een break, maar ik heb zelf het idee, dat het stukje code in
ThisDrawing niet gezien wordt door AutoCad.

[EddyBeerke]

Doen andere routines het wel die gemaakt zijn met VBA?

Wat is er trouwens met met de batch plot van acad?
Als je een template maakt met jou A3 en A4 (en de rest), dan kun je die gewoon importeren en gebruiken voor de hele set die je wilt afdrukken.

[willyver]

Heel het print programma werkt, op dat ene stukje na.
Andere vba's programma's gemaakt onder xp werken ook.

En dat is nu net het nadeel, het werken met template's. Je moet precies weten
welke tekeningen staan en welke liggen. En als je tekeningen binnen krijgt van een
klant weet je dat niet. En mijn programma draait de tekeningen zodat ze altijd
goed uit de printer komen.

[EddyBeerke]

heb je de stop al eens geprobeert?
Je gaf al aan dat het lijkt dat de

Code Selecteer Uitklappen

"Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)"overgeslagen wordt.
Om te kijken of dat zo is kun je een "stop" toepassen:

Code Selecteer Uitklappen

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
'*** Laat "CommandName" zien in het debug venster dit gebeurt bij elk commando in acad!!! (normaal gesproken dan)
Debug.Print CommandName
STOP
  If CommandName = "OPEN" Or strCMD = "_OPEN" Then
    frm_keuzemenu.Show
  End If
End Sub

Wat ik ook niet snap is deze regel:

Code Selecteer Uitklappen

If CommandName = "OPEN" Or strCMD = "_OPEN" Then
Hierin staan twee variabelen: "CommandName" & "strCMD"
Dit kan volgens mij niet, verander het in:

Code Selecteer Uitklappen

If CommandName = "OPEN" Or CommandName = "_OPEN" Then

TIP:
Wat ik zou gebruiken is het volgende:

Code Selecteer Uitklappen

Select case CommandName
  Case "OPEN"
    frm_keuzemenu.Show
  Case "_OPEN"
    frm_keuzemenu.Show
end select

Het voodeel daarvan is dat je meer commando's kunt opvangen. Ik heb er een gemaakt waarbij ik de maatvoering ik een speciale layer zet zonder elke keer van layer te wisselen.

[willyver]

Bedankt Eddy. De select case werkt.

Blijft het nog wel een raadsel waarom het onder xp wel werkte
en onder windows 7 x64 niet.

Wat betreft Commandname en strCMD, het werkt wel en er is een
bepaalde reden voor dat ik beide gebruikt, jammer genoeg is die mij
ontschoten.

[EddyBeerke]

Bedankt Eddy. De select case werkt.

Blijft het nog wel een raadsel waarom het onder xp wel werkte
en onder windows 7 x64 niet.

Wat betreft Commandname en strCMD, het werkt wel en er is een
bepaalde reden voor dat ik beide gebruikt, jammer genoeg is die mij
ontschoten.

Je zegt dat het werkt maar vervolgens werk het niet....
Dat kan ook niet als de macro die strCMD niet gebruikt alleen als het een globale var is.
In jou eerste code stond een IF CommansName ... OR strCMD:
Als CommansName juist is OF strCMD juist is.
Waarbij twee verschillende waarden ("OPEN" & "_OPEN" vergeleken worden.

De code met:

Code Selecteer Uitklappen

Select case CommandName
  Case "OPEN"
    frm_keuzemenu.Show
  Case "_OPEN"
    frm_keuzemenu.Show
end select
heeft alleen de CommandName gebruikt waarbij verschillende waarden (lees commando's) vergeleken worden.
Dat het nu wel werkt ligt aan het feit dat nu 1 var gebruikt is.
Ik denk zelf dat dit ook had gewerkt:

Code Selecteer Uitklappen

If CommandName = "OPEN" Or CommandName = "_OPEN" Then
...
End If

[willyver]

Bedankt voor de aangedragen oplossingen.