Community Tip - You can subscribe to a forum, label or individual post and receive email notifications when someone posts a new topic or reply. Learn more! X
Hello Everybody,
Im currently trying to automate the export of dxf files for laser cutting. We just use a seperate sheet in the parts drawing file with a single view of the unfolded sheet part. We always name this sheet "Laser".
Now in VB, I want to search the sheets in the drawing for the one named "Laser" to identify the right sheet to export as dxf, but I cant find any class or variable in the API to get the sheets names. Does someone have an idea for this problem or knows a different way, to savely identify the sheet in VB?
Solved! Go to Solution.
Thanks for the input Jack. That would be a good idea, because we always name the SimpRep the same. For now, i I managed to create a mapkey, that puts the sheets name into a .txt file with powershell. The only problem is, that the connection is asynchronous and VBA is way faster than powershell. This is the function which gives the name of the currently open sheet as a String:
Function Drw_Blatt_Name(ByRef CreoSession As pfcls.IpfcBaseSession) As String
Dim fso As New FileSystemObject
Dim txtFile As Object
Dim zeile As String
Dim Versuch As Integer
Dim maxVersuche As Integer
Versuch = 0
maxVersuche = 50 ' z. B. 50 × 100 ms = 5 Sekunden warten
'Pfad erstellen
Dim Pfad As String
Pfad = "C:/temp/Name_Blatt.txt"
'Blattname in Datei schreiben
CreoSession.RunMacro ("~ Command `ProCmdDwgPageSetup` ;\")
CreoSession.RunMacro ("~ Arm `pagesetup` `TblFormats` 2 `0` `sht`;\")
CreoSession.RunMacro ("~ Select `pagesetup` `TblFormats` 2 `0` `sht`;\")
CreoSession.RunMacro ("~ Key `pagesetup` `TblFormats` 37945347 `Strg+C`;~ Activate `pagesetup` `OK`;\")
CreoSession.RunMacro ("@SYSTEMpowershell Get-Clipboard -Format Text > " & Replace(Pfad, "/", "\\") & ";")
Debug.Print "== Start Drw_Blatt_Name =="
Debug.Print "Pfad: " & Pfad
' Warten, bis Datei vorhanden und nicht leer ist, und sich öffnen lässt
Do
If fso.FileExists(Pfad) Then
If FileLen(Pfad) > 0 Then
Debug.Print "Datei gefunden und nicht leer. Versuch Nr.: " & Versuch + 1
On Error Resume Next
Set txtFile = fso.OpenTextFile(Pfad, 1)
If Err.Number <> 0 Then Debug.Print "Fehler beim Öffnen: " & Err.Description
On Error GoTo 0
If Not txtFile Is Nothing Then
Debug.Print "Datei erfolgreich geöffnet."
Exit Do
Else
Debug.Print "Datei konnte nicht geöffnet werden (evtl. noch gesperrt?)."
End If
Else
Debug.Print "Datei vorhanden, aber noch leer. Versuch Nr.: " & Versuch + 1
End If
Else
Debug.Print "Datei noch nicht vorhanden. Versuch Nr.: " & Versuch + 1
End If
Versuch = Versuch + 1
If Versuch >= maxVersuche Then
Debug.Print "Maximale Versuche erreicht – Datei nicht lesbar."
Drw_Blatt_Name = "FEHLER: Fehler beim Lesen der Datei (nach mehreren Versuchen)."
Exit Function
End If
DoEvents
Sleep 100 ' 100 ms warten
Loop
' Erste Zeile lesen
On Error GoTo LesenFehlgeschlagen
If Not txtFile.AtEndOfStream Then
zeile = txtFile.ReadLine
Debug.Print "Erste Zeile gelesen: " & zeile
Else
Debug.Print "Datei ist leer."
End If
txtFile.Close
Debug.Print "Datei geschlossen."
' Datei löschen mit mehreren Versuchen
Dim delVersuch As Integer
For delVersuch = 1 To 10
On Error Resume Next
fso.DeleteFile Pfad, True
On Error GoTo 0
If Not fso.FileExists(Pfad) Then
Debug.Print "Datei gelöscht."
Exit For
End If
Debug.Print "Löschversuch " & delVersuch & " fehlgeschlagen, warte erneut..."
Sleep 100
DoEvents
Next delVersuch
If fso.FileExists(Pfad) Then
Debug.Print "Datei konnte nicht gelöscht werden."
Drw_Blatt_Name = "FEHLER: Datei konnte nicht gelöscht werden."
Exit Function
End If
' Erfolgreich
Drw_Blatt_Name = zeile
Debug.Print "== Funktion erfolgreich abgeschlossen =="
Exit Function
LesenFehlgeschlagen:
Debug.Print "Fehler beim Lesen der Datei: " & Err.Description
Drw_Blatt_Name = "FEHLER: Fehler beim Lesen der Datei."
End Function
Hi @SKerski
Thank you for your question.
Your post appears well documented but has not yet received any response. I am replying to raise awareness. Hopefully, another community member will be able to help.
Also, feel free to add any additional information you think might be relevant. For example:
It sometimes helps to have screenshots to better understand what you are trying to do.
Best regards,
It looks like the VB toolkit does not has access to the licensed methods unfortunately. In the C++ toolkit there is a licensed method wfcWDrawing::GetSheetName that would return the name of the sheet.
You could use IpfcView2D::GetSimpRep to get the SimpRep and the name of that SimpRep to help identify your sheets. Not sure if that would help or not
Thanks for the input Jack. That would be a good idea, because we always name the SimpRep the same. For now, i I managed to create a mapkey, that puts the sheets name into a .txt file with powershell. The only problem is, that the connection is asynchronous and VBA is way faster than powershell. This is the function which gives the name of the currently open sheet as a String:
Function Drw_Blatt_Name(ByRef CreoSession As pfcls.IpfcBaseSession) As String
Dim fso As New FileSystemObject
Dim txtFile As Object
Dim zeile As String
Dim Versuch As Integer
Dim maxVersuche As Integer
Versuch = 0
maxVersuche = 50 ' z. B. 50 × 100 ms = 5 Sekunden warten
'Pfad erstellen
Dim Pfad As String
Pfad = "C:/temp/Name_Blatt.txt"
'Blattname in Datei schreiben
CreoSession.RunMacro ("~ Command `ProCmdDwgPageSetup` ;\")
CreoSession.RunMacro ("~ Arm `pagesetup` `TblFormats` 2 `0` `sht`;\")
CreoSession.RunMacro ("~ Select `pagesetup` `TblFormats` 2 `0` `sht`;\")
CreoSession.RunMacro ("~ Key `pagesetup` `TblFormats` 37945347 `Strg+C`;~ Activate `pagesetup` `OK`;\")
CreoSession.RunMacro ("@SYSTEMpowershell Get-Clipboard -Format Text > " & Replace(Pfad, "/", "\\") & ";")
Debug.Print "== Start Drw_Blatt_Name =="
Debug.Print "Pfad: " & Pfad
' Warten, bis Datei vorhanden und nicht leer ist, und sich öffnen lässt
Do
If fso.FileExists(Pfad) Then
If FileLen(Pfad) > 0 Then
Debug.Print "Datei gefunden und nicht leer. Versuch Nr.: " & Versuch + 1
On Error Resume Next
Set txtFile = fso.OpenTextFile(Pfad, 1)
If Err.Number <> 0 Then Debug.Print "Fehler beim Öffnen: " & Err.Description
On Error GoTo 0
If Not txtFile Is Nothing Then
Debug.Print "Datei erfolgreich geöffnet."
Exit Do
Else
Debug.Print "Datei konnte nicht geöffnet werden (evtl. noch gesperrt?)."
End If
Else
Debug.Print "Datei vorhanden, aber noch leer. Versuch Nr.: " & Versuch + 1
End If
Else
Debug.Print "Datei noch nicht vorhanden. Versuch Nr.: " & Versuch + 1
End If
Versuch = Versuch + 1
If Versuch >= maxVersuche Then
Debug.Print "Maximale Versuche erreicht – Datei nicht lesbar."
Drw_Blatt_Name = "FEHLER: Fehler beim Lesen der Datei (nach mehreren Versuchen)."
Exit Function
End If
DoEvents
Sleep 100 ' 100 ms warten
Loop
' Erste Zeile lesen
On Error GoTo LesenFehlgeschlagen
If Not txtFile.AtEndOfStream Then
zeile = txtFile.ReadLine
Debug.Print "Erste Zeile gelesen: " & zeile
Else
Debug.Print "Datei ist leer."
End If
txtFile.Close
Debug.Print "Datei geschlossen."
' Datei löschen mit mehreren Versuchen
Dim delVersuch As Integer
For delVersuch = 1 To 10
On Error Resume Next
fso.DeleteFile Pfad, True
On Error GoTo 0
If Not fso.FileExists(Pfad) Then
Debug.Print "Datei gelöscht."
Exit For
End If
Debug.Print "Löschversuch " & delVersuch & " fehlgeschlagen, warte erneut..."
Sleep 100
DoEvents
Next delVersuch
If fso.FileExists(Pfad) Then
Debug.Print "Datei konnte nicht gelöscht werden."
Drw_Blatt_Name = "FEHLER: Datei konnte nicht gelöscht werden."
Exit Function
End If
' Erfolgreich
Drw_Blatt_Name = zeile
Debug.Print "== Funktion erfolgreich abgeschlossen =="
Exit Function
LesenFehlgeschlagen:
Debug.Print "Fehler beim Lesen der Datei: " & Err.Description
Drw_Blatt_Name = "FEHLER: Fehler beim Lesen der Datei."
End Function