Change model parameter format to fractional using VBA Macro

[joels9LNRF]

Hello Autodesk Community,

We currently have a library of stock parts in our system that are using a decimal format that all need to change to fractional format with a1/64 precision. I have very little experience writing VBA code.

I would like the macro to:

1.) Identify the model parameters within the part labeled "Thick", "Width", and "Length", and ensure that these parameters are marked for export and are using fractional formatting to a 1/64 precision with no "units string". (If the parameters Thick, Width, & Length do not exist, have it notify the user somehow.)

2.) Enter the equation "=PL <Thick> A36 X <Width> X <Length>" into both the "Title" and "Description" in the iproperties.

Any help would be greatly appreciated.

Thank you.

- Joel

[WCrihfield]

Hi @joels9LNRF.  Give this a try.

Sub ExportParamsAndSetTitle()
    If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        Call MsgBox("A Part document must be 'active' for this VBA macro to work.  Exiting macro.", vbCritical, "")
        Exit Sub
    End If
    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    Dim oParams As Inventor.Parameters
    Set oParams = oPDef.Parameters
    
    Dim oThickParam As Inventor.Parameter
    Dim oWidthParam As Inventor.Parameter
    Dim oLengthParam As Inventor.Parameter
    
    On Error Resume Next 'ignore errors after this line
    Set oThickParam = oParams.Item("Thick")
    If Err <> 0 Then
        Call MsgBox("Could not find parameter named 'Thick'.  Exiting macro.", vbCritical, "")
        Exit Sub
    End If
    Err.Clear
    
    Set oWidthParam = oParams.Item("Width")
    If Err <> 0 Then
        Call MsgBox("Could not find parameter named 'Width'.  Exiting macro.", vbCritical, "")
        Exit Sub
    End If
    Err.Clear
    
    Set oLengthParam = oParams.Item("Length")
    If Err <> 0 Then
        Call MsgBox("Could not find parameter named 'Length'.  Exiting macro.", vbCritical, "")
        Exit Sub
    End If
    Err.Clear
    On Error GoTo 0 'stop ignoring errors after this line
    
    Dim oMyParams As New Collection
    oMyParams.Add (oThickParam)
    oMyParams.Add (oWidthParam)
    oMyParams.Add (oLengthParam)
    Dim oMyParam As Inventor.Parameter
    For Each oMyParam In oMyParams
        If oMyParam.ExposedAsProperty = False Then
        oMyParam.ExposedAsProperty = True
    End If
    oMyParam.CustomPropertyFormat.PropertyType = kTextPropertyType
    oMyParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
    oMyParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
    oMyParam.CustomPropertyFormat.ShowUnitsString = False
    
    Dim oTitleProp As Inventor.Property
    Set oTitleProp = oPDoc.PropertySets.Item("Inventor Summary Information").Item("Title")
    
    Dim oDescriptionProp As Inventor.Property
    Set oDescriptionProp = oPDoc.PropertySets.Item("Design Tracking Properties").Item("Description")
    
    Dim oValue As String
    oValue = "=PL <Thick> A36 X <Width> X <Length>"
    
    oTitleProp.Value = oValue
    oDescriptionProp.Value = oValue
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.

If you want and have time, I would appreciate your Vote(s) for My IDEAS :bulb: or you can Explore My CONTRIBUTIONS

[joels9LNRF]

Hi, thank you for your help.

I'm getting a compile error "For without Next".

[WCrihfield]

OK.  I see it now.

This:

    For Each oMyParam In oMyParams
        If oMyParam.ExposedAsProperty = False Then
        oMyParam.ExposedAsProperty = True
    End If
    oMyParam.CustomPropertyFormat.PropertyType = kTextPropertyType
    oMyParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
    oMyParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
    oMyParam.CustomPropertyFormat.ShowUnitsString = False

needs to be updated to this:

    For Each oMyParam In oMyParams
        If oMyParam.ExposedAsProperty = False Then
	        oMyParam.ExposedAsProperty = True
	    End If
	    oMyParam.CustomPropertyFormat.PropertyType = kTextPropertyType
	    oMyParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
	    oMyParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
	    oMyParam.CustomPropertyFormat.ShowUnitsString = False
	Next

[joels9LNRF · Accepted solution]

That fixed the compile error. The code was stopping at the line "For each oMyParam In oMyParams" saying that oMyParams = Nothing. So, I'm assuming no parameters were making it into the collection for some reason. I commented that section out and used the code for each individual parameter individually below and the code runs perfectly! I'm sure it's not as efficient as it would have been using a collection, but it's giving me the right results.

Thank you for your help!

Sub Format()
If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
Call MsgBox("A Part document must be 'active' for this VBA macro to work. Exiting macro.", vbCritical, "")
Exit Sub
End If
Dim oPDoc As PartDocument
Set oPDoc = ThisApplication.ActiveDocument

Dim oPDef As PartComponentDefinition
Set oPDef = oPDoc.ComponentDefinition

Dim oParams As Inventor.Parameters
Set oParams = oPDef.Parameters

Dim oThickParam As Inventor.Parameter
Dim oWidthParam As Inventor.Parameter
Dim oLengthParam As Inventor.Parameter

On Error Resume Next 'ignore errors after this line
Set oThickParam = oParams.Item("Thick")
If Err <> 0 Then
Call MsgBox("Could not find parameter named 'Thick'. Exiting macro.", vbCritical, "")
Exit Sub
End If
Err.Clear

Set oWidthParam = oParams.Item("Width")
If Err <> 0 Then
Call MsgBox("Could not find parameter named 'Width'. Exiting macro.", vbCritical, "")
Exit Sub
End If
Err.Clear

Set oLengthParam = oParams.Item("Length")
If Err <> 0 Then
Call MsgBox("Could not find parameter named 'Length'. Exiting macro.", vbCritical, "")
Exit Sub
End If
Err.Clear
On Error GoTo 0 'stop ignoring errors after this line

'Dim oMyParams As New Collection
'oMyParams.Add (oThickParam)
'oMyParams.Add (oWidthParam)
'oMyParams.Add (oLengthParam)
'Dim oMyParam As Inventor.Parameter
'For Each oMyParam In oMyParams
'If oMyParam.ExposedAsProperty = False Then
'oMyParam.ExposedAsProperty = True
'End If
'oMyParam.CustomPropertyFormat.PropertyType = kTextPropertyType
'oMyParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
'oMyParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
'oMyParam.CustomPropertyFormat.ShowUnitsString = False
'Next

If oThickParam.ExposedAsProperty = False Then
oThickParam.ExposedAsProperty = True
End If
oThickParam.CustomPropertyFormat.PropertyType = kTextPropertyType
oThickParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
oThickParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
oThickParam.CustomPropertyFormat.ShowUnitsString = False

If oWidthParam.ExposedAsProperty = False Then
oWidthParam.ExposedAsProperty = True
End If
oWidthParam.CustomPropertyFormat.PropertyType = kTextPropertyType
oWidthParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
oWidthParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
oWidthParam.CustomPropertyFormat.ShowUnitsString = False

If oLengthParam.ExposedAsProperty = False Then
oLengthParam.ExposedAsProperty = True
End If
oLengthParam.CustomPropertyFormat.PropertyType = kTextPropertyType
oLengthParam.CustomPropertyFormat.Units = UnitsTypeEnum.kInchLengthUnits
oLengthParam.CustomPropertyFormat.Precision = kSixtyFourthsFractionalLengthPrecision
oLengthParam.CustomPropertyFormat.ShowUnitsString = False

Dim oTitleProp As Inventor.Property
Set oTitleProp = oPDoc.PropertySets.Item("Inventor Summary Information").Item("Title")

Dim oDescriptionProp As Inventor.Property
Set oDescriptionProp = oPDoc.PropertySets.Item("Design Tracking Properties").Item("Description")

Dim oValue As String
oValue = "=PL <Thick> A36 X <Width> X <Length>"

oTitleProp.Value = oValue
oDescriptionProp.Value = oValue
End Sub

[WCrihfield]

Good to hear you got it working.  The collection was just an unnecessary means to process all parameters in a loop, instead of individually anyways.  I use VBA far less than iLogic, and even then, rarely use Collections, so I may not have used it correctly when initiating the loop.  You are probably not supposed to pre-define the Type of the variable used or something like that.

[joels9LNRF]

I really appreciate you're help. You have saved a me a lot of time and effort.