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 :
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.
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.
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
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:
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.
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.
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.
heb je de stop al eens geprobeert?
Je gaf al aan dat het lijkt dat de "Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)"overgeslagen wordt.
Om te kijken of dat zo is kun je een "stop" toepassen:
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:
If CommandName = "OPEN" Or strCMD = "_OPEN" Then
Hierin staan twee variabelen: "CommandName" & "strCMD"
Dit kan volgens mij niet, verander het in:
If CommandName = "OPEN" Or CommandName = "_OPEN" Then
TIP:
Wat ik zou gebruiken is het volgende:
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.
Bedankt Eddy. De select case werkt. :vreegoe:
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.
Citaat van: willyver op ma 22 08 2011, 12:05:54
Bedankt Eddy. De select case werkt. :vreegoe:
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:
Select case CommandName
Case "OPEN"
frm_keuzemenu.Show
Case "_OPEN"
frm_keuzemenu.Show
end selectheeft 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:
If CommandName = "OPEN" Or CommandName = "_OPEN" Then
...
End If
Bedankt voor de aangedragen oplossingen.