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