Hi everyone,
I am trying to make a macro that copies the cutlist properties into configuration properties. I could do it for a part with one configuration using the following macro. The problem is for configurations that are not active it returns values like "LENGTH@@@Cut-List-Item4@Weldment.SLDPRT" instead of the actual length. I am not sure what I am missing here.
Regards,
Saeed
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Sub main()
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim strValue As String
Dim ThisFeat As SldWorks.Feature
Dim ThisSubFeat As SldWorks.Feature
Dim CutFolder As SldWorks.BodyFolder
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set ThisFeat = swModel.FirstFeature
Do While Not ThisFeat Is Nothing
Set ThisSubFeat = ThisFeat.GetFirstSubFeature
Do While Not ThisSubFeat Is Nothing
If ThisSubFeat.GetTypeName = "CutListFolder" Then
Set CutFolder = ThisSubFeat.GetSpecificFeature2
End If
If Not CutFolder Is Nothing Then
If CutFolder.GetBodyCount > 0 Then
Call LinkToCustomProperties(ThisSubFeat)
End If
End If
Set ThisSubFeat = ThisSubFeat.GetNextSubFeature
Loop
Set ThisFeat = ThisFeat.GetNextFeature
Loop
End Sub
Sub LinkToCustomProperties(CutListFeature As SldWorks.Feature)
Dim cutlistPropMgr As SldWorks.CustomPropertyManager
Dim propNames As Variant
Dim vName As Variant
Dim propName As String
Dim Value As String
Dim resolvedValue As String
Dim config As SldWorks.Configuration
Dim customPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim i As Integer
Dim sConfigName As String
Dim vConfigName As Variant
Dim SolidBodyFeature As SldWorks.Feature
Dim SolidBodyBodyFolder As BodyFolder
Dim MyFeatureManager As Object
Set cutlistPropMgr = CutListFeature.CustomPropertyManager
vConfigName = swModel.GetConfigurationNames
'Go through the configurations and add all the cutlist properties for all the configurations to configuration properties
For i = 0 To UBound(vConfigName)
sConfigName = vConfigName(i)
swModel.ShowConfiguration2 (sConfigName)
Set MyFeatureManager = swModel.FeatureManager
'Update Feature manager
MyFeatureManager.EnableFeatureTree = True
MyFeatureManager.UpdateFeatureTree
'Force rebuild the part
swModel.ForceRebuild3 True
Set SolidBodyFeature = swModel.FirstFeature
Do While Not SolidBodyFeature Is Nothing
If SolidBodyFeature.GetTypeName2 = "SolidBodyFolder" Then
Set SolidBodyBodyFolder = SolidBodyFeature.GetSpecificFeature2
If SolidBodyBodyFolder.UpdateCutList Then
Exit Do
End If
End If
Set SolidBodyFeature = SolidBodyFeature.GetNextFeature
Loop
Set config = swModel.GetConfigurationByName(sConfigName)
Debug.Print sConfigName
Set customPropMgr = config.CustomPropertyManager
If Not cutlistPropMgr Is Nothing Then
propNames = cutlistPropMgr.GetNames
If Not IsEmpty(propNames) Then
Debug.Print CutListFeature.Name, CutListFeature.GetTypeName
For Each vName In propNames
propName = vName
Call cutlistPropMgr.Get2(propName, Value, resolvedValue)
Debug.Print "", "", propName, Value, resolvedValue
lRetVal = customPropMgr.Add3(CutListFeature.Name & "_" & propName, swCustomInfoType_e.swCustomInfoText, resolvedValue, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Next vName
End If
End If
Next
End Sub
SolidworksApi macros