Laurens Ruben
Laurens Ruben

Reputation: 109

Catia VBA Saving specific parts or products from a .stp file as .CATPart and/or .CATProduct

I have an .stp file, exported with a different CAD-software, which I can open with CATIA. CATIA will then list the product/part tree as if it were a native CATIA .CATProduct.

My goal is to automate opening such an .stp file with CATIA and saving all contained parts/products with a name that is extracted from one of the UserRefProperties in each of these parts/products. Therefore I want to create a macro with VBA which when completed will run in batch mode.

My first problem arises when I try to save the parts/products in this .stp file, Catia's save function handles my file as desired and will save each part/product as a separate file. However, using VBA I can't seem to be able to save any of these parts/products since the .ExportData and .SaveAs methods only seem to work on .PartDocument or .ProductDocument objects instead of the objects which I've been trying to save: .Product objects.

Example of what I'm trying to do:

Sub catmain()

Dim oProdDoc As ProductDocument
Set oProdDoc = CATIA.ActiveDocument

Dim oRootProd As Product
Set oRootProd = oProdDoc.Product

Dim oInstances As Products
Set oInstances = oRootProd.Products

For k = 1 To oInstances.Count

Dim oInst As Product
Set oInst = oInstances.Item(k)

oInst.ExportData "X:\path", ".CATPart"

next

end sub

If CATIA can save my .stp file's contents as desired, surely I can do the same with VBA, right?

Any help would be greatly appreciated.

Upvotes: 0

Views: 4991

Answers (1)

C R Johnson
C R Johnson

Reputation: 1101

The Product at the root of the tree can be saved as a CATProduct document. Any sub-products within the tree can also be saved as a CATProduct. The Parts, which are the leaves of the tree can be saved as CATParts.

You can save the root Product like this:

Dim rootProdDoc As ProductDocument
set rootProdDoc = CATIA.ActiveDocument
rootProdDoc.SaveAs "C:\Temp\" & rootProd.PartNumber & ".CATProduct"

However, when you do this, CATIA will complain that "This activates other save operations, do you want to continue?" It does this because the Parts are not yet saved. Answering yes CATIA will save your assembly and all the parts. However because you are not in control of the part saving it will preclude you from setting the names for those documents you want.

And because you have to answer a dialog, it will prevent you from making a batch program.

The right way to do this is to first save the leaf documents and then work "up" the tree the root level by level. Then everything will be saved when you need it to be.

----------Class clsSaveInfo definition--------------

Public level As Integer
Public prod As Product


-----------------(module definition)--------------- 

Option Explicit


Sub CATMain()

    CATIA.DisplayFileAlerts = False

    'get the root product
    Dim rootProd As Product
    Set rootProd = CATIA.ActiveDocument.Product

    'make a dictionary to track product structure
    Dim docsToSave As Scripting.Dictionary
    Set docsToSave = New Scripting.Dictionary

    'some parameters
    Dim level As Integer
    Dim maxLevel As Integer

    'read the assembly
    level = 0
    Call slurp(level, rootProd, docsToSave, maxLevel)

    Dim i
    Dim kx As String
    Dim info As clsSaveInfo

    Do Until docsToSave.count = 0
        Dim toRemove As Collection
        Set toRemove = New Collection
        For i = 0 To docsToSave.count - 1
           kx = docsToSave.keys(i)

           Set info = docsToSave.item(kx)

           If info.level = maxLevel Then
                Dim suffix As String
               If TypeName(info.prod) = "Part" Then
                    suffix = ".CATPart"
               Else
                    suffix = ".CATProduct"
                End If
                Dim partProd As Product
                Set partProd = info.prod
                Dim partDoc As Document
                Set partDoc = partProd.ReferenceProduct.Parent
                partDoc.SaveAs ("C:\Temp\" & partProd.partNumber & suffix)
                toRemove.add (kx)
            End If

        Next

     'remove the saved products from the dictionary
        For i = 1 To toRemove.count
            docsToSave.Remove (toRemove.item(i))
        Next

        'decrement the level we are looking for
        maxLevel = maxLevel - 1
    Loop


End Sub


Sub slurp(ByVal level As Integer, ByRef aProd As Product, ByRef allDocs As Scripting.Dictionary, ByRef maxLevel As Integer)

'increment the level
    level = level + 1

'track the max level
    If level > maxLevel Then maxLevel = level

 'see if the part is already in the save list, if not add it
    If allDocs.Exists(aProd.partNumber) = False Then
        Dim info As clsSaveInfo
        Set info = New clsSaveInfo
        info.level = level
        Set info.prod = aProd
        Call allDocs.add(aProd.partNumber, info)
    End If

'slurp up children
    Dim i
    For i = 1 To aProd.products.count
        Dim subProd As Product
        Set subProd = aProd.products.item(i)
        Call slurp(level, subProd, allDocs, maxLevel)
    Next

End Sub

Upvotes: 1

Related Questions