Frame Generator VBA Macro - Get Cut Lengths

[isocam]

Can anybody help?

I am trying to create a VBA macro that extracts all the "Cut Lengths" and  "Section Types" in a frame generated with "Frame Generator".

Attached in the macro that I have got so far.

(I have changed the filename from ".bas" to ".txt")

Does anybody know what I am doing wrong with the macro, as it does not work, or, has anybody got another macro that does the same thing?

Many thanks in advance!!!!

Darren

[JhoelForshav]

Hi @isocam 

I made some edits to your code...

Try this:

Public Function GetCutLengths()

    Dim oDoc As Inventor.AssemblyDocument



    Set oDoc = ThisApplication.ActiveDocument



    Dim oCompDef As Inventor.ComponentDefinition



    Set oCompDef = oDoc.ComponentDefinition



    Dim sMsg As String



    Dim iLeafNodes As Long



    Dim iFunctionAssemblies As Long



    Dim oCompOcc As ComponentOccurrence



    For Each oCompOcc In oCompDef.Occurrences

        If oCompOcc.DefinitionDocumentType = kPartDocumentObject Then

           iLeafNodes = iLeafNodes + 1



           Call Bounding_Box_Height(oCompOcc)

        Else

           iFunctionAssemblies = iFunctionAssemblies + 1



           Call ProcessAllFunctionOcc(oCompOcc, sMsg, iLeafNodes, iFunctionAssemblies)

        End If

    Next



    oDoc.Update



    oDoc.Save

End Function



Private Function ProcessAllFunctionOcc(ByVal oCompOcc As ComponentOccurrence, ByRef sMsg As String, ByRef iLeafNodes As Long, ByRef iFunctionAssemblies As Long)

    Dim oFunctionCompOcc As ComponentOccurrence



    For Each oFunctionCompOcc In oCompOcc.SubOccurrences

        If oFunctionCompOcc.DefinitionDocumentType = kPartDocumentObject Then

            iLeafNodes = iLeafNodes + 1



            Call Bounding_Box_Height(oFunctionCompOcc)

        Else

            sMsg = sMsg + oFunctionCompOcc.Name + vbCr



            iFunctionAssemblies = iFunctionAssemblies + 1



            Call ProcessAllFunctionOcc(oFunctionCompOcc, sMsg, iLeafNodes, iFunctionAssemblies)

        End If

    Next

End Function



Private Function Bounding_Box_Height(ByRef oCompOcc As ComponentOccurrence)

    Dim oDoc As Object



    Dim oparams As Parameters



    Dim oparam As Parameter



    Set oDoc = oCompOcc.Definition.Document



    Set oparams = oDoc.ComponentDefinition.Parameters



    If (TypeOf oDoc Is PartDocument) And (oDoc.IsModifiable) And (oDoc.DocumentInterests.HasInterest("{AC211AE0-A7A5-4589-916D-81C529DA6D17}")) Then

       Dim maxz As Double



       Dim minz As Double



       Dim height As Double



       maxz = oCompOcc.Definition.RangeBox.MaxPoint.Z



       minz = oCompOcc.Definition.RangeBox.MinPoint.Z



       height = maxz - minz



       For Each oparam In oparams.UserParameters

           If oparam.Name = "G_L" Then oparam.Value = height

       Next oparam

    End If

End Function

[JhoelForshav]

Looking at your code and your description of what you want to accomplish though, I think this would do what you want...

Sub GetLengths()
Dim oAsm As AssemblyDocument
Set oAsm = ThisApplication.ActiveDocument
Dim Msg As String
Dim oOcc As ComponentOccurrence
Dim oUM As UnitsOfMeasure
Set oUM = oAsm.UnitsOfMeasure
For Each oOcc In oAsm.ComponentDefinition.Occurrences.AllLeafOccurrences
    Dim oDoc As Document
    Set oDoc = oOcc.Definition.Document
    If (TypeOf oDoc Is PartDocument) _
        And (oDoc.IsModifiable) _
        And (oDoc.DocumentInterests.HasInterest _
        ("{AC211AE0-A7A5-4589-916D-81C529DA6D17}")) Then
     Dim maxz As Double
       Dim minz As Double
       Dim height As Double
       maxz = oOcc.Definition.RangeBox.MaxPoint.Z
       minz = oOcc.Definition.RangeBox.MinPoint.Z
       height = maxz - minz
       On Error Resume Next
       If height <> 0 Then
        oDoc.ComponentDefinition.Parameters.UserParameters.Item("G_L").Value = height
        Msg = Msg & oOcc.Name & " - " & oUM.GetStringFromValue(height, oUM.LengthUnits) _
        & " - " & oDoc.PropertySets.Item("Design Tracking Properties").Item("Size Designation").Value & vbCrLf
        End If
    End If
Next
oAsm.Update
MsgBox Msg
End Sub

[isocam]

Jhoel,

Can I please ask if it is possible to also get the "Family" name using the VBA macro that you posted, below?

Please see the attached picture.

Many thanks in advance!!!

Darren

[JhoelForshav · Accepted solution]

@isocam 

Try this:

Sub GetLengths()
Dim oAsm As AssemblyDocument
Set oAsm = ThisApplication.ActiveDocument
Dim Msg As String
Dim oOcc As ComponentOccurrence
Dim oUM As UnitsOfMeasure
Set oUM = oAsm.UnitsOfMeasure
For Each oOcc In oAsm.ComponentDefinition.Occurrences.AllLeafOccurrences
    Dim oDoc As Document
    Set oDoc = oOcc.Definition.Document
    If (TypeOf oDoc Is PartDocument) _
        And (oDoc.IsModifiable) _
        And (oDoc.DocumentInterests.HasInterest _
        ("{AC211AE0-A7A5-4589-916D-81C529DA6D17}")) Then
     Dim maxz As Double
       Dim minz As Double
       Dim height As Double
       maxz = oOcc.Definition.RangeBox.MaxPoint.Z
       minz = oOcc.Definition.RangeBox.MinPoint.Z
       height = maxz - minz
       On Error Resume Next
       If height <> 0 Then
        oDoc.ComponentDefinition.Parameters.UserParameters.Item("G_L").Value = height
        Msg = Msg & oOcc.Name & " - " & oUM.GetStringFromValue(height, oUM.LengthUnits) _
        & " - " & oDoc.PropertySets.Item("Design Tracking Properties").Item("Size Designation").Value & _
         "- Family: " & oDoc.PropertySets.Item("Content Library Component Properties").Item("Family").Value & vbCrLf
        End If
    End If
Next
oAsm.Update
MsgBox Msg
End Sub