CATIA mass measure macro taking too much time to complete.

[pieswt]

Hello Friends,

I have created a macro to measure mass of each part in an Assembly(CatProduct). thread560-514012
The macro is exporting BOM of complete assembly as excel file and then using that BOM to get mass of each part present in the assembly.
The macro is working fine and giving desired outputs but it is taking too much time.

Can you help me to make the macro faster?

here is my code:

Public Template As String
Sub ExportBOMandMeasureWeight()
    
    Call BrowseForFolderDialogBox(Template)
    If Template <> "" Then
    Template = Template & "\" & Left(CATIA.ActiveDocument.Name, Len(CATIA.ActiveDocument.Name) - 11) & ".xls"
    
    Else
    GoTo finish1
    End If
    
    Dim productDocument1 As ProductDocument
    Set productDocument1 = CATIA.ActiveDocument
    
    Dim product1 As Product
    Set product1 = productDocument1.Product

    Dim assemblyConvertor1 As AssemblyConvertor
    Set assemblyConvertor1 = product1.GetItem("BillOfMaterial")

    Dim arrayOfVariantOfBSTR1(3)
    arrayOfVariantOfBSTR1(0) = "Quantity"
    arrayOfVariantOfBSTR1(1) = "Part Number"
    arrayOfVariantOfBSTR1(2) = "Type"
    arrayOfVariantOfBSTR1(3) = "PTC_WM_NAME"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR1

    Dim arrayOfVariantOfBSTR2(1)
    arrayOfVariantOfBSTR2(0) = "Quantity"
    arrayOfVariantOfBSTR2(1) = "Part Number"
    Set assemblyConvertor1Variant = assemblyConvertor1
    assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR2
   
    assemblyConvertor1.[Print] "HTML", Template, product1

    MsgBox "Bom Exported Successfully!" & vbCr & "Now measuring weight and density."
    
    Call Getweight

finish1:
End Sub


Sub Getweight()
Dim BOMExcel As Object

'modify settings to measure only shown elements by default
    Call MeasureShownElements
    
On Error Resume Next

'if Excel is already running, then get the Excel object
Set BOMExcel = GetObject(, "Excel.Application")


If Err.Number <> 0 Then
    'If Excel is not already running, then create a new session of Excel
    Set BOMExcel = CreateObject("Excel.Application")
    BOMExcel.Visible = True
End If

'add a new workbook
BOMExcel.Workbooks.Open (Template)
BOMExcel.Visible = True
Set ws = BOMExcel.ActiveWorkbook.Sheets(1)

ws.Cells(4, 6).Value = "CAD Weight"
ws.Cells(4, 7).Value = "Density"
ws.Cells(4, 8).Value = "Hide/Show Status"
With ws
    Set findrow = .Range("A:A").Find(What:="Recapitulation", LookIn:=xlValues)
    
End With


Findrownumber = findrow.Row
If IsEmpty(Findrownumber) = True Then
MsgBox "Error"
GoTo Finish
End If
For i = 1 To Findrownumber - 1
        
        
        PNtoSearch = ws.Cells(i, 2).Value
        'measure weight
        Set productDocument1 = CATIA.ActiveDocument
        Set product1 = productDocument1.Product
        Dim oSelection As Selection
        Set oSelection = CATIA.ActiveDocument.Selection
     
        If ws.Cells(i, 3).Value = "Part" Then
        
        oSelection.Search "CATAsmSearch.Part.PartNumber=" & PNtoSearch & ",all"
        
        Dim showstate As CatVisPropertyShow
        Set visProperties1 = oSelection.VisProperties
        visProperties1.GetShow showstate

        Dim objProd As Product
        
        Set objProd = CATIA.ActiveDocument.Selection.Item2(1).Value
        Set objInertia = GetProductInertia(objProd)
          If Not (objInertia Is Nothing) Then
            'Retrieve the mass just to show it worked
            'MsgBox objInertia.Mass
            ws.Cells(i, 6).Value = objInertia.Mass * 1000
            ws.Cells(i, 7).Value = objInertia.Density / 1000
            ws.Cells(i, 8).Value = showstate
            
          Else
            MsgBox "The Inertia could not be retrieved!"
          End If
        End If
        
        If ws.Cells(i, 3).Value = "Assembly" Then
        
            oSelection.Search "CATAsmSearch.Assembly.PartNumber=" & PNtoSearch & ",all"
            
            'Dim showstate As CatVisPropertyShow
            Set visProperties1 = oSelection.VisProperties
            visProperties1.GetShow showstate
            'MsgBox showstate
            
            ws.Cells(i, 8).Value = showstate
            
        End If
Next i

MsgBox "Weight Exported!"

'BOMExcel.ActiveWorkbook.Save

Filename = ActiveWorkbook.FullName
If InStr(Filename, ".") > 0 Then
   Filename = Left(Filename, InStr(Filename, ".xls") - 1)
End If

ws.SaveAs Filename:=Filename & "_with Weight.xlsx", FileFormat:=xlWorkbookDefault

Finish:

End Sub


Function GetProductInertia(ByRef iProd As Product) As Inertia
 
 '27DEC modify settings to measure only shown elements by default
    'Call MeasureShownElements
    
    
  'If successful, this function will return an inertia object
  'Otherwise, Nothing is returned (you should check the return value)
 
  Dim objInertia As Inertia

  On Error Resume Next
 
  Set objInertia = iProd.ReferenceProduct.GetTechnologicalObject("Inertia")
  'Set ObjDensity = iProd.ReferenceProduct.GetTechnologicalObject("Density")
  If Err.Number = 0 Then
    Set GetProductInertia = objInertia
  Else
    Set GetProductInertia = Nothing
End If
End Function

Sub BrowseForFolderDialogBox(FolderPath As String)

    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = &H1
    
    Dim objShellApp
    Dim objFolder
    Dim objFldrItem
    Dim objPath
    
    Set objShellApp = CreateObject("Shell.Application")
    Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle, NO_OPTIONS)
    
    If Not objFolder Is Nothing Then
        Set objFldrItem = objFolder.Self
        objPath = objFldrItem.Path
        FolderPath = objPath
    Else
        MsgBox "Selection Cancelled..!"
    End If
    
    Set objShellApp = Nothing
    Set objFolder = Nothing
    Set objFldrItem = Nothing


End Sub

Sub MeasureShownElements()

Dim settingControllers1 As SettingControllers
Set settingControllers1 = CATIA.SettingControllers

Dim measureSettingAtt1 As MeasureSettingAtt
Set measureSettingAtt1 = settingControllers1.Item("CATSPAMeasureSettingCtrl")

Dim boolean1 As Boolean
boolean1 = measureSettingAtt1.PartUpdateStatus

Dim boolean2 As Boolean
boolean2 = measureSettingAtt1.ProductUpdateStatus

Dim boolean3 As Boolean
boolean3 = measureSettingAtt1.TildeDisplay

Dim long1 As Long
Dim long2 As Long
Dim long3 As Long
measureSettingAtt1.GetLabelColor long1, long2, long3

Dim short1 As Integer
short1 = measureSettingAtt1.LineWidth

Dim long4 As Long
Dim long5 As Long
Dim long6 As Long
measureSettingAtt1.GetTextColor long4, long5, long6

Dim boolean4 As Boolean
boolean4 = measureSettingAtt1.BoxDisplay

measureSettingAtt1.Commit

Dim boolean5 As Boolean
boolean5 = measureSettingAtt1.PartUpdateStatus

Dim boolean6 As Boolean
boolean6 = measureSettingAtt1.ProductUpdateStatus

Dim boolean7 As Boolean
boolean7 = measureSettingAtt1.TildeDisplay

Dim long7 As Long
Dim long8 As Long
Dim long9 As Long
measureSettingAtt1.GetLabelColor long7, long8, long9

Dim short2 As Integer
short2 = measureSettingAtt1.LineWidth

Dim long10 As Long
Dim long11 As Long
Dim long12 As Long
measureSettingAtt1.GetTextColor long10, long11, long12

Dim boolean8 As Boolean
boolean8 = measureSettingAtt1.BoxDisplay

measureSettingAtt1.PartUpdateStatus = True
measureSettingAtt1.ProductUpdateStatus = True
measureSettingAtt1.TildeDisplay = True

Dim settingRepository1 As SettingRepository
Set settingRepository1 = settingControllers1.Item("MeasureSettings")
settingRepository1.PutAttr "MeasureOnlyShownElementsStatus", 1
measureSettingAtt1.SaveRepository
measureSettingAtt1.Commit

End Sub

 

[LWolf]

If you look at the properties of a part (inside an assembly): it is possible to add additional properties (Define other properties)--
You can add your own mass parameter (and measure some weight that you associate with that parameter).
This weight property is accessible in the BOM creation under "Define Formats".
So basically you work directly with the BOM, rather than looking up the excel output... much faster.


regards,
LWolf

 

[pieswt]

HEllo LWolf,
Thank You for your reply!

I am working with Existing assemblies with 150+ parts. Do I need to add mass parameter to each part or only adding to Top level assembly is enough? Can you please elaborate?

Is there any other quicker way to get the weight of each part along with BOM from those assemblies?

Thanks!

 

[LWolf]

Each part must then have that parameter (along with a mass assignment to it). But it should be waaaay faster to work with parts rather than shuffling data in and out of excel. So yes, write a script that assigns a parameter to each part, and measures weight of each partbody (or other bodies if you wish)

regards,
LWolf

 

[itsmyjob]

Can you tell us if it take also way to much time if you run the script a second time right after the first run?

Eric N.
indocti discant et ament meminisse periti ​