Catia V5 Macro - Generate CATPart from CATProduct

Catia V5 Macro - Generate CATPart from CATProduct

Please read Liability Disclaimer and License Agreement CAREFULLY

My Catia V5 Macro allows you to quickly and easily generate a CATPart from a CATProduct. With just a few clicks, you can extract the required components and convert them into a single CATPart file, saving you valuable time and effort.

My Catia V5 Macro is perfect for those who frequently work with large assemblies and need to extract specific parts for further analysis or modification. The macro simplifies the process of creating new CATParts, helping you streamline your design workflow.

Don't waste any more time manually extracting parts from your assemblies - try our Catia V5 Macro today and start optimizing your design workflow. 

Start By creating a new VBA project and then copy and paste the code below in it.

Sub CATMain()
    Dim Warning As Integer
    Warning = MsgBox("Notice!!!" & VBA.Chr(13) & "Copyright © 2004 Grozea Ion" & VBA.Chr(13) & "Do you wish to continue?", vbYesNo, "Product2Part")
    If Warning = 6 Then
        If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then
            MsgBox "CATIA active document is not valid!" & VBA.Chr(13) & "This macro runs only on CATProduct.", vbExclamation, "Product2Part!!!"
            Exit Sub
        Else
            GenerateCATPartFromProduct
        End If
    Else
        Exit Sub
    End If
End Sub

Sub GenerateCATPartFromProduct()
    Dim ActiveDoc As ProductDocument
    Dim CrtSelection As Selection
    Dim PauseTime, Start, Finish, TotalTime
    Set ActiveDoc = CATIA.ActiveDocument
    Set CrtSelection = CATIA.ActiveDocument.Selection
    With CrtSelection
        .Clear
        .Add ActiveDoc.Product         '.Products.Item(1)
    End With
    With CATIA
        .RefreshDisplay = True
        .StartCommand "Generate CATPart from Product..."
        .RefreshDisplay = True
        PauseTime = 0.5
        Start = Timer
        Do While Timer < (Start + PauseTime)
            DoEvents
        Loop
        Finish = Timer
        TotalTime = Finish - Start
        .RefreshDisplay = True
    End With
	//On some OS this command is generating errors
	//Comment the SendKeys below if you are in this situation
    SendKeys "{Enter}", True
 
    Set CrtSelection = Nothing
    Set ActiveDoc = Nothing
End Sub