AnsweredAssumed Answered

Adding Custom properties from cut-list properties not always correct

Question asked by Frank Van Eygen on Oct 30, 2019
Latest reply on Nov 6, 2019 by Frank Van Eygen

In a macro I am trying to add custom properties (and equations) for an active part.

Adding these properties works but the evaluated values are not always what I expect them to be.

When the procedure 'Show_All_FolderProps' is run then the immediate window is filled with the folder props and cut-list properties.

When I then enter the 'formulas' from the cut-list properties for 'Test Custom Props1.SLDPRT' in the custom properties window this is OK.

When I do the same for 'Test Custom Props2.SLDPRT' this is not OK.

 

Does anybody have an idea why the formulas in 'Test Custom Props1.SLDPRT' are giving an expected evaluated value and in 'Test Custom Props1.SLDPRT'  this is not the case?

 

 

Sub Show_All_FolderProps()
'list up the custom properties of the active part in the immediate window
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim strValue As String
Dim strValueOut As String
Dim PropNames As Variant
Dim iCol1 As Integer
Dim iCol2 As Integer

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature

If swModel.GetType = swDocDRAWING Then
bPartIsReady = False
bAssembly = False
Else
If swModel.GetType = swDocASSEMBLY Then
bPartIsReady = True
bAssembly = True
Else
'Valid part was found
bPartIsReady = True
bAssembly = False
End If
End If

iCol1 = 40

Debug.Print "Active model: " & swModel.GetTitle
If bPartIsReady = True Then
Do While Not swFeat Is Nothing
'loop through all folders/features in active part
Debug.Print "Feat-name: " & swFeat.Name & String(iCol1 - Len("Feat-name: " & swFeat.Name), ".") & "Feat-Type: " & swFeat.GetTypeName
'If swFeat.GetTypeName() = "CutListFolder" Then

'get sub-features
If swFeat.GetTypeName = "Reference" Then
'do nothing
Else
Set swSubFeat = swFeat.GetFirstSubFeature
'If Not swSubFeat Is Nothing Then Debug.Print strPad & vbTab & "SubFeatures:"
Do While Not swSubFeat Is Nothing
Debug.Print vbTab & "Sub-feat name: " & swSubFeat.Name & Space(iCol1 - Len("Sub-feat name: " & swSubFeat.Name)); " Sub-feat type: " & swSubFeat.GetTypeName
Set swSubFeat = swSubFeat.GetNextSubFeature
Loop
End If

Set swCustPropMgr = swFeat.CustomPropertyManager
If Not swCustPropMgr Is Nothing Then
'get all custom property names and fill variant propNames
PropNames = swCustPropMgr.GetNames
If Not IsEmpty(PropNames) Then
'Debug.Print "Feat-name: " & swFeat.Name & String(iCol1 - Len("Feat-name: " & swFeat.Name), ".") & "Feat-Type: " & swFeat.GetTypeName

'establish iCol1
For Each vName In PropNames
propName = vName
swCustPropMgr.Get4 propName, False, strValue, strValueOut
If iCol1 < Len("Prop name: " & propName) + 5 Then iCol1 = Len("Prop name: " & propName) + 5
Next vName

'establish iCol2
For Each vName In PropNames
propName = vName
swCustPropMgr.Get4 propName, False, strValue, strValueOut
If iCol2 < Len("Prop name: " & propName & Space(iCol1 - Len("Prop name: " & propName)) & " Prop expression: " & strValue) + 5 Then iCol2 = Len("Prop name: " & propName & Space(iCol1 - Len("Prop name: " & propName)) & " Prop expression: " & strValue) + 5
Next vName

'print props in Immediate window
For Each vName In PropNames
propName = vName
swCustPropMgr.Get4 propName, False, strValue, strValueOut
Debug.Print vbTab & "Prop name: " & propName & Space(iCol1 - Len("Prop name: " & propName)) & " Prop expression: " & strValue & Space(iCol2 - Len("Prop name: " & propName & Space(iCol1 - Len("Prop name: " & propName)) & " Prop expression: " & strValue)) & " Prop ev. value: " & strValueOut
Next vName
Else
If swCustPropMgr.count > 0 Then Debug.Print , "Aantal custom props: " & swCustPropMgr.count
End If
End If
'End If
Set swFeat = swFeat.GetNextFeature
Loop
Else
MsgBox "This macro is only useful with a part or assy." & Chr$(13) & Chr$(10) & "Open one of those and try again."
Exit Sub
End If
End Sub

 

Thx

Frank

Outcomes