Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

3DExperience Run-time error with macro

Status
Not open for further replies.

Azzazil

Automotive
Feb 1, 2020
95
HR
Hi, I am writing macro to loop through product and measure Mass,Volume,Area and other properties of parts.
The thing is that sometimes script is working without any flaw, while sometimes I get error message "Run-time error '-2147467259 (80004005) The method GetMass failed" on same product that script was worked yesterday without any flaw.

The same is sometimes with GetArea, GetVolume, I was thinking that maybe the part is problem but I can measure Mass, Volume and Area of the part with "Measure Inertia".

Here is code, bolded is place where I am getting errors.:
Code:
Sub Looping_through_product()

    Dim oProductEditor As Editor
    Set oProductEditor = CATIA.ActiveEditor
    
    NavigateProductOccurance oProductEditor
    
        
End Sub

Sub NavigateProductOccurance(oProductEditor)


    Dim oProductService As PLMProductService
    Set oProductService = oProductEditor.GetService("PLMProductService")
    
    Dim oVPMRootOccOnRoot As VPMRootOccurrence
    Set oVPMRootOccOnRoot = oProductService.RootOccurrence
    
    'Recursive function
    NavigateProdOccurences oProductEditor, oVPMRootOccOnRoot, 0
    

End Sub

Sub NavigateProdOccurences(oProductEditor, oOccurance, depth)

    Dim oListChildrenOccurences As VPMOccurrences
    Set oListChildrenOccurences = oOccurance.Occurrences

    For i = 1 To oListChildrenOccurences.Count
        
        Dim oChildOcc As VPMOccurrence
        Set oChildOcc = oListChildrenOccurences.Item(i)
        
        InertiaInfo oProductEditor, oChildOcc
        
        NavigateProdOccurences oProductEditor, oChildOcc, depth + 1
    Next
    
End Sub

Sub InertiaInfo(oProductEditor, oChildOcc)

    Dim oInertiaService As InertiaService
    Set oInertiaService = oProductEditor.GetService("InertiaService")
    
    Dim oInertiaBoxService As InertiaBoxService
    Set oInertiaBoxService = oProductEditor.GetService("InertiaBoxService")
    
    Dim oInertiaElement As Variant
    Set oInertiaElement = oInertiaService.GetInertiaElement(oChildOcc)
    
    Dim oInertiaElement_2 As Object
    Set oInertiaElement_2 = oInertiaElement
    
    Dim oInertiaBoxElement As Variant
    Set oInertiaBoxElement = oInertiaBoxService.GetInertiaBoxElement(oChildOcc)
        
    oInertiaElement_2.OnlyMainBody
    
    Dim oName As String
    oName = oChildOcc.Name
    
    Dim oArea As Double
    oArea = oInertiaElement_2.[b]GetArea[/b]
    
    Dim oVolume As Double
    oVolume = oInertiaElement_2.[b]GetVolume[/b]
    
    Dim oMass As Double
    oMass = oInertiaElement_2.[b]GetMass[/b]
    
    Dim oCOG(2) As Variant
    oInertiaElement_2.GetCOGPosition oCOG(0), oCOG(1), oCOG(2)

    Dim oMatrix(8) As Variant
    oInertiaElement_2.GetInertiaMatrix oMatrix

    Dim oAxes(8) As Variant
    oInertiaElement_2.GetPrincipalAxes oAxes

    Dim oMoments(2) As Variant
    oInertiaElement_2.GetPrincipalMoments oMoments
    
    Dim oBoundingBoxOrigin(2) As Variant
    Dim oBoundingBoxLengths(2) As Variant
    oInertiaBoxElement.GetBoundingBox oBoundingBoxOrigin, oBoundingBoxLengths

    DisplayResults oName, oArea, oVolume, oMass, oCOG, oMatrix, oBoundingBoxOrigin, oBoundingBoxLengths

End Sub

Private Sub DisplayResults(oName, oArea, oVolume, oMass, oCOG, oMatrix, oBoundingBoxOrigin, oBoundingBoxLengths)

    ' Texts to Display
    Dim NameTxt As String, AreaTxt As String, VolumeTxt As String, MassTxt As String, CofGTxt As String, InMxTxt As String, BBoxOriginTxt As String, BBoxLengthsTxt As String
    NameTxt = "Name:"
    AreaTxt = "Area:" & vbTab & vbTab
    VolumeTxt = "Volume:" & vbTab & vbTab
    MassTxt = "Mass:" & vbTab & vbTab
    CofGTxt = "Center of Gravity:"
    InMxTxt = "Inertia Matrix / G:"
    BBoxOriginTxt = "BBox Origin:"
    BBoxLengthsTxt = "BBox Lengths:"

    Dim AreaUnit As String, VolumeUnit As String, MassUnit As String, CofGUnit As String, InMxUnit As String
    AreaUnit = " m2"
    VolumeUnit = " m3"
    MassUnit = " kg"
    CofGUnit = " m"
    InMxUnit = " kgxm2"

    ' Display format
    Dim DisplayFmt As Integer
    DisplayFmt = 12

    ' Message to display
    Dim strMessage As String
    strMessage = NameTxt & oName & vbLf
    strMessage = strMessage & AreaTxt & FormatNumber(oArea, DisplayFmt) & AreaUnit & vbLf
    strMessage = strMessage & VolumeTxt & FormatNumber(oVolume, DisplayFmt) & VolumeUnit & vbLf
    strMessage = strMessage & MassTxt & FormatNumber(oMass, DisplayFmt) & MassUnit & vbLf
    strMessage = strMessage & CofGTxt & vbTab & "X = " & FormatNumber(oCOG(0), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "Y = " & FormatNumber(oCOG(1), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "Z = " & FormatNumber(oCOG(2), DisplayFmt) & CofGUnit & vbLf & vbLf

    strMessage = strMessage & InMxTxt & vbLf
    strMessage = strMessage & vbTab & vbTab & "IoxG  = " & FormatNumber(oMatrix(0), DisplayFmt) & InMxUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "IoyG  = " & FormatNumber(oMatrix(4), DisplayFmt) & InMxUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "IozG  = " & FormatNumber(oMatrix(8), DisplayFmt) & InMxUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "IoxyG = " & FormatNumber(oMatrix(3), DisplayFmt) & InMxUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "IoxzG = " & FormatNumber(oMatrix(6), DisplayFmt) & InMxUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "IoyzG = " & FormatNumber(oMatrix(7), DisplayFmt) & InMxUnit & vbLf & vbLf

    strMessage = strMessage & BBoxOriginTxt & vbLf
    strMessage = strMessage & vbTab & vbTab & "OriginX  = " & FormatNumber(oBoundingBoxOrigin(0), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "OriginY  = " & FormatNumber(oBoundingBoxOrigin(1), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "OriginZ  = " & FormatNumber(oBoundingBoxOrigin(2), DisplayFmt) & CofGUnit & vbLf

    strMessage = strMessage & BBoxLengthsTxt & vbLf
    strMessage = strMessage & vbTab & vbTab & "LengthX  = " & FormatNumber(oBoundingBoxLengths(0), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "LengthY  = " & FormatNumber(oBoundingBoxLengths(1), DisplayFmt) & CofGUnit & vbLf
    strMessage = strMessage & vbTab & vbTab & "lengthZ  = " & FormatNumber(oBoundingBoxLengths(2), DisplayFmt) & CofGUnit & vbLf
    MsgBox strMessage, vbInformation


End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top