Product To Step Export

Usage:

• Start Catia and and open up a CATProduct,
• show hide components as required (the macro works the same way as Catia - “what you see is what you export”)
• run this macro …

' -----------------------------------------------------------------------------
' ProductToStepExport.CATScript
' -----------------------------------------------------------------------------
' (c) 2010, Johann Oberdorfer - Engineering Support | CAD | Software
'     johann.oberdorfer [at] googlemail.com
'     www.johann-oberdorfer.eu
' -----------------------------------------------------------------------------
' This source file is distributed under the BSD license.
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
'   See the BSD License for more details.
' -----------------------------------------------------------------------------
'
' Purpose:
'
' In general:
'   Allows to write all associated "CADPart" models of a CATProduct
'   to a different export format (STEP). This could be done by hand, but is
'   especially useful for bigger models / bigger assemblies
'   with a lot of components.
' - enjoy -
'
' Tasks performed by the script:
'   - Read the product structure of a given CATProduct and save
'     each individual component as a Step file.
'   - Takes only those components into account, which are in show mode!
'   - For each export task, a unique directory behind EXPORT_DIR is created.
'
' Installation requirements:
'   - Please specify the EXPORT_DIR in the configuration section, where
'     files should be written to. Remember that each export job creates it's
'     own timestaped directory here. Existing files won't be overwritten.
' -----------------------------------------------------------------------------
'
' Revision History:
'
' Dec. 2011,  J.Oberdorfer: Initial Release
' 11.12.2011, Johann: fallback solution using the system's temp directory,
'             in case EXPORT_DIR hasn't been properly declared
'             or points to a non existing dir
' -----------------------------------------------------------------------------
Option Explicit
Language="VBSCRIPT"
' ---------------------
' Configuration Section
' ---------------------
Const THIS_SCRIPT  = "--- ProductToStepExport V1.0 ---"
Const EXPORT_DIR = "Z:\STEP_Export"
Const EXPORT_FILE_EXT = ".stp"
Const EXPORT_FILE_FORMAT = "stp"
' -------------------------
' End Configuration Section
' -------------------------
Function IsInShownMode (ByVal Item As AnyObject) As Boolean
    Dim cSel As Collection
    Dim showstate As CatVisPropertyShow
    Set cSel = CATIA.ActiveDocument.Selection
    IsInShownMode = FALSE
    cSel.Clear
    cSel.Add Item
    cSel.VisProperties.GetShow showstate
        
    If (showstate = catVisPropertyShowAttr) Then
        ' MsgBox "IsInShownMode -->" + Item.Name
        IsInShownMode = TRUE
    End If
End Function

Function GetModelName (ByVal current_product As Product) As String
    Dim model_name, component_name As String
    Dim fs As FileSystem
    Set fs = CATIA.FileSystem
    GetModelName = ""
    current_product.ApplyWorkMode DESIGN_MODE
    ' errror handling is required
    ' if the product does not contain an associated CATPart,
    ' an error accures when calling: ReferenceProduct.Parent.Part.Name
    Err.Clear : On Error Resume Next
    component_name = current_product.ReferenceProduct.Parent.Part.Name
    If Err.Number <> 0 Then
        On Error Goto 0
        Exit Function
    End If
    On Error Goto 0
    
    ' is there a better way to read the associated CATPart (?):
    model_name = fs.ConcatenatePaths( _
                    current_product.ReferenceProduct.Parent.Path, _
                    component_name)
    model_name = model_name + ".CATPart"
                    
    IF ( fs.FileExists(model_name) ) Then
        GetModelName = model_name
    End If
End Function

' // list append
' // append a given string to the data (list) array
' // - if mode is set to "unique", it is cheched, wether the string is already a
' //   member of the list or not
' // - empty strings are not taken into account
' //
Sub LAppend (ByRef data_list() As Variant, ByVal str As String, ByVal mode As String)
    Dim i, cnt, add_item As Integer
    
    If ( str = "" ) Then
        Exit Sub
    End If
    add_item = 1
    If ( mode = "unique" ) Then
        For i = 1 To UBound(data_list)
            If ( str = data_list(i) ) Then
                ' MsgBox "--> " + str + vBNewLine + data_list(i)
                add_item = 0
                Exit For
            End If
        Next
    End If
    If (add_item = 1) Then
        ' append the string to the (list) array
        cnt = UBound(data_list) + 1
        ReDim Preserve data_list(cnt)
        data_list(cnt) = str
    End If
        
End Sub

Sub ReadProductTree (ByVal productList As Products, _
                     ByRef data_list As Variant)
    Dim i As Integer
    Dim subProducts As Products
    Dim model_name As String
    For i = 1 to productList.Count
        ' product must be in-show mode
        IF ( IsInShownMode( productList.Item(i) ) = TRUE ) Then
            If productList.Item(i).Products.Count > 0 Then
                ' ASSEMBLY - recursive call ...
                Set subProducts = productList.Item(i).Products
                Call ReadProductTree (subProducts, data_list)
            Else
                ' PART - component print out
                model_name = GetModelName ( productList.Item(i) )
                LAppend data_list, model_name, "unique"
            End If
        End If
    Next
End Sub

Sub    ConvertArrayToString (ByVal arr() As Variant, ByRef str As String)
    Dim i As Integer
    Dim str_item As String
    str = ""
    For i = 1 To Ubound(arr)
        str_item = CStr( arr(i) )        
        If ( str_item <> "" ) Then
            str = str + vBNewline + str_item
        End If
    Next
    ' MsgBox "Array Content:" + vBNewline + str
End Sub

' // get the filename from a given full path filename
' //
Function GetFileTailName (ByVal full_path_name As String) As String
    Dim arr As Array
    Dim fs As FileSystem
    Set fs = CATIA.FileSystem
    arr = split (full_path_name, fs.FileSeparator, -1, vbTextCompare)
    ' remove leading path, file name is the last item of
    ' the array returned by the split function
    GetFileTailName = arr ( UBound(arr) )
End Function

' // --------------------------------------------------------------------------
' // here we go...
' // --------------------------------------------------------------------------
' //
Sub CATMain ()
    Dim msg_str, indexStr, _
        full_path_name, model_name, export_file_name, _
        time_stamp, current_export_dir, temp_dir As String
    Dim i, _
        isFirstLevel, isNextLevel, isThirdLevel, isAssembly As Integer
    Dim this_doc, current_doc As Document
    Dim this_product As Product
    Dim data_list() As Variant
    Dim fs As FileSystem
    CATIA.RefreshDisplay = FALSE
    ' -- initialization
    Set this_doc = CATIA.ActiveDocument
    Set fs = CATIA.FileSystem
    ' -- check, if there is a product on the screen or not...
    If (TypeName(this_doc) <> "ProductDocument") Then
        Msgbox _
            "Your active Document type: " + TypeName(this_doc) + vBNewline _
        +    "is not valid for this action." + vBNewline _
        +    vBNewline _
        +    "Please open a CATProduct and try again!", _
            vbExclamation + vbOKOnly, "Warning:"
        Exit Sub
    End If
    ' -- specify the root product
    Set this_product = this_doc.Product
    ReDim Preserve data_list(0)
    ' -----------------------------------------------------
    Call ReadProductTree (this_product.Products, data_list)            
    ' -----------------------------------------------------
    
    ' -- ? any cad models availabel
    If ( Ubound(data_list) = 0 ) Then
        Msgbox _
            "Your active Product does not contain any associated CATPart." + vBNewline _
        +    vBNewline _
        +    "Please make shure, components are in show mode," + vBNewline _
        +    "or otherwise open another CATProduct and try again!", _
            vbExclamation + vbOKOnly, "Warning:"
        Exit Sub
    End If
    
    ' -- create a unique export directory
    IF ( fs.FolderExists(EXPORT_DIR) ) Then
        temp_dir = EXPORT_DIR
    Else
        temp_dir = fs.TemporaryDirectory
        
        If ( Msgbox( _
                  "The default export directory: " + EXPORT_DIR + " does not exist!" + vBNewline _
                + "The current temporary dir: " + temp_dir +  " is used instead." + vBNewline _
                + vBNewline _
                + "Do you like to continue?", _
                vbQuestion + vbOkCancel, "Question:") = 2 ) Then
            ' cancel button (=2) pressed
            Exit Sub
        End If
        
    End If
    time_stamp = CStr( Date ) + "_" + Replace (Time, ":", ".", 1, -1, vbTextCompare)
    current_export_dir = fs.ConcatenatePaths(temp_dir, this_product.Name + time_stamp)
    ' -development-
    ' ConvertArrayToString data_list, msg_str : MsgBox "--> " + msg_str : Exit Sub
    ' -- ? really like to export
    If ( Msgbox( _
              "About to export " + CStr(Ubound(data_list)) + " CATPart model(s)." + vBNewline _
            + "Export directory used: " + current_export_dir + vBNewline _
            + vBNewline _
            + "Do you like to continue?", _
            vbQuestion + vbOkCancel, "Question:") = 2 ) Then 
        Exit Sub
    End If
    fs.CreateFolder(current_export_dir)
    ' -- now, save each associated CATPart as a step file ...
    For i = 1 To Ubound(data_list)
        full_path_name = data_list(i)
        model_name = GetFileTailName ( full_path_name )
        model_name = Replace (model_name, ".CATPart", EXPORT_FILE_EXT, 1, -1, vbTextCompare)
        export_file_name = fs.ConcatenatePaths(current_export_dir, model_name)
        ' -- clean existing step file prior to write the new one:
        '    has become obsolete now, as we do create a new directory for each export task
        ' If ( fs.FileExists(export_file_name) ) Then fs.DeleteFile export_file_name End If
        ' MsgBox "About to write Step file: " + export_file_name
        Set current_doc = CATIA.Documents.Open( full_path_name )
        ' ---------------------------------------------------------            
        current_doc.ExportData export_file_name, EXPORT_FILE_FORMAT
        current_doc.Close()
        ' ---------------------------------------------------------            
    Next
    ' -- status message ...
    Msgbox _
            "Export successfully finished - " + CStr( Ubound(data_list) ) + " Model(s) exported." + vBNewline _
        +     "Data has been written to the following directory:" + vBNewline _
        +    vBNewline _
        +    current_export_dir + vBNewline _
        +    vBNewline _
        +    "Thank you for using the macro." + vBNewline _
        +     "(C) 2011, Johann Oberdorfer," + vBNewline _
        +     "Engineering Support | CAD | Software Development," + vBNewline _
        +     "www.johann-oberdorfer.eu", _
            vbInformation + vbOKOnly, "Info:"
    CATIA.RefreshDisplay = TRUE
End Sub