Macro for creating CATproduct from CATpart which contains multilayered geosets

[ARSRoy]

Hi all,

I'm trying to create a macro which converts a CATpart containing multilayered geosets into a CATproduct. I have attached a screenshot which shows, how the product needs to look when converted from Catpart. Also, I found a macro on this forum which creates CATproduct from a CATpart containing bodies. I tweaked it to work with geosets. But, I couldn't make it work for multilayered geosets.

Below code is written by user LINGSHUYING. I tweaked it to work for geosets instead of bodies.

Sub GreateProductsFromBodies_SelectAllBodies()
    'Purpose : Create  Product's  from Part's Bodies
    'add Error control and connect to CATIA application
    On Error Resume Next
    Set CATIA = GetObject(, "CATIA.Application")
    
    'Declare variables
    Dim oPartDoc As PartDocument
    Dim oPart As Part
    Dim oProductDoc As ProductDocument
    Dim oProduct As Product
    
    'Create a new ProductDoc and rename it's PartNumber equals to Partdoc's PartNumber
    Set oPartDoc = CATIA.ActiveDocument
    Set oProductDoc = CATIA.Documents.Add("Product")
    oProductDoc.Product.PartNumber = oPartDoc.Product.PartNumber
    
    'Arrange windows use "Title Vertically" ,then active window contain Partdoc
    CATIA.Windows.Arrange catArrangeTiledVertical
    CATIA.Windows.Item(1).Activate
    
    'Check the Body's name use "For ... Next"loop . If Body's name duplicate,then rename.
    Dim k As Integer, x As Integer
    For x = 1 To oPartDoc.Part.HybridBodies.Count
        For k = 1 To oPartDoc.Part.HybridBodies.Count
            If oPartDoc.Part.HybridBodies.Item(k).name = oPartDoc.Part.HybridBodies.Item(x).name And k <> x Then
                oPartDoc.Part.HybridBodies.Item(k).name = oPartDoc.Part.HybridBodies.Item(x).name & "_Rename_" & k
            End If
        Next
    Next
    
    
    'Copy Bodies from PartDocument
    Dim i As Integer, j As Integer, ProductPN As String, FinalProductPN As String
    For i = 1 To oPartDoc.Part.HybridBodies.Count
        With oPartDoc.Selection
            .Clear
            .Add oPartDoc.Part.HybridBodies.Item(i)
            .Copy
            .Clear
        End With
        
        'Modify the Product's PartNumber,replace "\" and "."to "_" ,then delete Space
        ProductPN = oPartDoc.Part.HybridBodies.Item(i).name
        If Right(ProductPN, 1) = "\" Then
            ProductPN = Left(ProductPN, Len(ProductPN) - 1)
        End If
        FinalProductPN = Replace(Replace(Replace(ProductPN, "\", "_"), ".", "_"), " ", "") 'Replace "\" and "."to "_",Delete Space
        
          'Paste Body in Product's Part as Result
        Set oProduct = oProductDoc.Product.Products.AddNewComponent("Part", FinalProductPN) 'Add Part
        With oProductDoc.Selection
            .Clear
            .Add oProductDoc.Product.Products.Item(i).ReferenceProduct.Parent.Part
            .PasteSpecial "CATPrtResultWithOutLink"
            .Clear
        End With
        oProductDoc.Product.Products.Item(i).ReferenceProduct.Parent.Part.Update
    Next
    
End Sub

 

[LWolf]

your multilayerd geosets, will they contain a mix of features and geosets?...
if not, you need to see if there are geosets under, or just geometries and act accordingly

regards,
LWolf

 

[ARSRoy]

Hello LWolf,

Thanks for your reply. No, it only contains geosets which eventually contains geometric elements and hybrid shapes.

From your sentence , I can only think of If statements. Please see below. I'm not sure how to call the Hybrid shapes or Geomteric elements.

For i = 1 To oPartDoc.Part.HybridBodies.Count
         If oPartDoc.Part.HybridBodies.Item(i) = oPartDoc.Part.HybridBodies.HybridBody Then
                Set oProduct = oProductDoc.Product.Products.AddNewComponent("Product", FinalProductPN) 'Add Product
         'FinalProductPN will be defined
          ElseIf oPartDoc.Part.HybridBodies.Item(i) = oPartDoc.Part.HybridBodies.HybridBody.HybridShapes Then
               Set oProduct = oProductDoc.Product.Products.AddNewComponent("Part", FinalProductPN) 'Add part

         Endif

 

[LWolf]

try to create a recursive function, i.e for each hybridbody encountered, check whether there is/are any other hybridbodies within...
if yes then call on the function again with the new hybridbody, else create a part from that set.
so, when you are investigating a hybridbody, it has properties Hybridbody.hybridbodies.count

regards,
LWolf

 

[weagan22]

This could really balloon into a lot of products being created. I really question why you would want/need this functionality.