cancel
Showing results for 
Search instead for 
Did you mean: 
cancel
Showing results for 
Search instead for 
Did you mean: 

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

Translate the entire conversation x

Creo 11 VBA API get drawing sheet name

SKerski
10-Marble

Creo 11 VBA API get drawing sheet name

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? 

ACCEPTED SOLUTION

Accepted Solutions
SKerski
10-Marble
(To:jack15)

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

View solution in original post

3 REPLIES 3

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:

  • What steps have you taken so far to search for the sheet named "Laser" in the drawing using the Creo VBA API?
  • Have you checked the Creo VBA API documentation for any classes or methods related to drawing sheets?
  • Do you have any existing code snippets that you have tried?

It sometimes helps to have screenshots to better understand what you are trying to do.

 

Best regards,


Catalina
PTC Community Moderator
PTC
jack15
12-Amethyst
(To:SKerski)

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

SKerski
10-Marble
(To:jack15)

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
Announcements

Top Tags