×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

3DExperience Run-time error with macro

3DExperience Run-time error with macro

3DExperience Run-time error with macro

(OP)
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 --> VBA

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.GetArea
    
    Dim oVolume As Double
    oVolume = oInertiaElement_2.GetVolume
    
    Dim oMass As Double
    oMass = oInertiaElement_2.GetMass
    
    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 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login


Resources

eBook - The Future of Product Development is Here
Looking to make the design and manufacturing of your products more agile? For engineering and manufacturing organizations, the need for digital transformation of product development processes just became more urgent than ever so we wanted to share an eBook that will help you build a practical roadmap for your journey. Download Now

Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close