---

Hello

I would like to create a macro which for each catpart found in source folder (pointed by user) saves it as 3dxml, preferrably under subfolder "3DXML" created under source folder

What would be the solution?

So far I have (AI generated):

Code:

---

Function PickFolderDialog(prompt As String) As String
    Dim objShell As Object
    Dim objFolder As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, prompt, 0, 0)

    If Not objFolder Is Nothing Then
        PickFolderDialog = objFolder.Self.path
    Else
        PickFolderDialog = ""
    End If
End Function

Sub ExportCATPartsTo3DXML()

    Dim sourceFolder As String
    Dim targetFolder As String
    Dim fileName As String
   
    Dim prodDoc As ProductDocument
    Dim catPart As Document

    '--- pick source folder ---
    sourceFolder = PickFolderDialog("Select folder with CATPart files")
    If sourceFolder = "" Then Exit Sub
    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"

    '--- create 3DXML folder ---
    targetFolder = sourceFolder & "3DXML\"
    If Dir(targetFolder, vbDirectory) = "" Then MkDir targetFolder

    '--- loop CATPart files ---
    fileName = Dir(sourceFolder & "*.CATPart")
    If fileName = "" Then
        MsgBox "No CATPart files found"
        Exit Sub
    End If

    Do While fileName <> ""

        'Open CATPart
        Set catPart = CATIA.Documents.Open(sourceFolder & fileName)

        'Create temporary product
        Set prodDoc = CATIA.Documents.Add("Product")
        prodDoc.Product.Products.AddComponent catPart

        'Export 3DXML
        Dim xmlPath As String
        xmlPath = targetFolder & Replace(fileName, ".CATPart", ".3dxml")

        prodDoc.ExportData xmlPath, "3DXML"

        'Close docs
        catPart.Close
        prodDoc.Close

        fileName = Dir()
    Loop

    MsgBox "3DXML export completed!", vbInformation

End Sub

---

but it gives me an error "type mismatch" in

Code:

---

rootProd.Products.AddExternalComponent fullPath

---

line.

AI code seems always too complicated for me, so I thought you guys could advice me how to approach  my problem 

Any advice would be appreciated 
THanks

Lucas

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

---

code update:

Code:

---

Option Explicit

Sub ExportFolder_CATPart_To_3DXML()

    Dim sourceFolder As String
    Dim fileName As String
    Dim fullPath As String
    Dim xmlPath As String
    Dim doc As Document
   
    '--- wybór folderu ---
    sourceFolder = PickFolderDialog("Wybierz folder z plikami CATPart")
    If sourceFolder = "" Then Exit Sub
    If Right$(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
   
    '--- folder docelowy ---
    Dim targetFolder As String
    targetFolder = sourceFolder & "3dxml\"
    If Dir$(targetFolder, vbDirectory) = "" Then MkDir targetFolder
   
    '--- iteracja po plikach ---
    fileName = Dir$(sourceFolder & "*.CATPart")
   
    Do While fileName <> ""
       
        fullPath = sourceFolder & fileName
       
        'otwórz dokument *niewidocznie*
        Set doc = CATIA.Documents.Open(fullPath)
       
        'ścieżka 3DXML
        xmlPath = targetFolder & doc.Name & ".3dxml"
       
        '--- EXPORT 3DXML ---
        doc.ExportData xmlPath, "3dxml"
       
        'zamknij dokument bez zapisu
        doc.Close
       
        fileName = Dir$()
    Loop
   
    MsgBox "Gotowe. Eksport zakończony.", vbInformation

End Sub

'-------------------------------------------------------
' 64-bit safe FolderPicker (Shell)
'-------------------------------------------------------
Function PickFolderDialog(prompt As String) As String
    Dim sh As Object, fld As Object
    Set sh = CreateObject("Shell.Application")
    Set fld = sh.BrowseForFolder(0, prompt, 0, 0)
    If Not fld Is Nothing Then PickFolderDialog = fld.Self.path
End Function

---

it seems working, but I would like to run it in the background, without screen flickering  how to modify it?

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

---

Hi Lucas

You could use CATIA.RefreshDisplay = False to not update the screen.
Or start a additional CATIA instance and run the macro there. (see https://catia2.cad.de/index.php/de/tipps-tricks/administration/274-makro-bei-catia-start-ausfuehren)

Regards,
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hi Bernd

Thanks for the Tip.

Unfortunately, my CATIA is being launched with an extra user interface (without access to CATIA shortcut), so I have to try first option.
I'll check and get back with feedback.

Thank you!

Lucas

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

---

I'm back again 

Here's my code:

Code:

---

Option Explicit

'===============================
' GŁÓWNY BATCH EXPORT
'===============================
Sub Export_CATParts_With_Progress()

    CATIA.RefreshDisplay = False

    Dim sourceFolder As String
    Dim targetFolder As String
    Dim fileName As String
    Dim files As New Collection
    Dim f As Variant
    Dim doc As Document
    Dim xmlPath As String
    Dim i As Long
   
    '--- wybór folderu ---
    sourceFolder = PickFolderDialog("Wybierz folder z plikami CATPart")
    If sourceFolder = "" Then Exit Sub
    If Right$(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
   
    '--- folder 3dxml ---
    targetFolder = sourceFolder & "3dxml\"
    If Dir$(targetFolder, vbDirectory) = "" Then MkDir targetFolder
   
    '--- zbierz listę plików ---
    fileName = Dir$(sourceFolder & "*.CATPart")
    Do While fileName <> ""
        files.Add fileName
        fileName = Dir$()
    Loop
   
    If files.Count = 0 Then
        MsgBox "Brak plików CATPart."
        Exit Sub
    End If
   
    '--- uruchom progress bar ---
    UF_Progress.LBL_Info.Caption = "Rozpoczynam..."
    UF_Progress.LBL_Bar.Width = 0
    UF_Progress.Show vbModeless
    DoEvents
   
    '===============================
    '    PRZETWARZANIE WSZYSTKICH PLIKÓW
    '===============================
   
    For i = 1 To files.Count
       
        'aktualizacja paska
        UpdateProgress i, files.Count, files(i)
       
        'pełna ścieżka
        Dim fullPath As String
        fullPath = sourceFolder & files(i)
       
        '=========================
        ' ciche otwarcie dokumentu
        '=========================
        CATIA.DisplayFileAlerts = False    'bez alertów
        Set doc = CATIA.Documents.Open(fullPath)
       
        'ścieżka wynikowa
        xmlPath = targetFolder & doc.Name & ".3dxml"
       
        'eksport
        doc.ExportData xmlPath, "3dxml"
       
        'zamknij cicho
        doc.Close
       
        DoEvents
    Next i
   
    'zamknij progress bar
    Unload UF_Progress

    CATIA.RefreshDisplay = True
    MsgBox "Zakończono eksport " & files.Count & " plików.", vbInformation

End Sub

'===============================
'  AKTUALIZACJA PASKA POSTĘPU
'===============================
Sub UpdateProgress(current As Long, total As Long, fileName As String)
   
    Dim percent As Double
    percent = current / total
   
    With UF_Progress
        '.LBL_Info.Caption = "Przetwarzanie: " & vbNewLine & fileName & _
                            "  (" & current & " / " & total & ")"
        .LBL_Info.Caption = fileName & _
                            "  (" & current & " / " & total & ")"
        .LBL_Bar.Width = percent * (.Frame1.Width - 10)
    End With
   
    DoEvents
End Sub

'===============================
'  FOLDER PICKER – 64-bit safe
'===============================
Function PickFolderDialog(prompt As String) As String
    Dim sh As Object, fld As Object
    Set sh = CreateObject("Shell.Application")
    Set fld = sh.BrowseForFolder(0, prompt, 0, 0)
    If Not fld Is Nothing Then PickFolderDialog = fld.Self.path
End Function

---

but I can still see parts being opened/closed 

Any other idea?

Lucas

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

---

Hi

Try .Read instead of .Open.

Regards,
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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