Collect Config Specific Custom Properties

Hi there,

I'm trying to collect the configuration specific custom property 'ConfigPartNo' from out a part or an assembly.

Therefore I use the configpropmanager inside the API.

It's working but it's very slow, take too much time to switch to another configuration due:

Set swConfigPropMgr = swModel.Extension.CustomPropertyManager(retvalConfig(k))

See the complete code below.

Does anybody know a better way to collect the CSCP ?

Greetings !

Option Explicit

Sub Main()

Debug.Print "Module GetPropertiesAndSize"

Dim swApp           As SldWorks.SldWorks

Dim bIsX64          As Boolean 'UserFormOnTop on x64

Dim swModel         As SldWorks.ModelDoc2

Dim swModelExt      As SldWorks.ModelDocExtension

Dim swPart          As SldWorks.PartDoc

Dim swConfig        As SldWorks.Configuration

Dim swCustPropMgr   As SldWorks.CustomPropertyManager

Dim swConfigPropMgr As SldWorks.CustomPropertyManager

Dim swConfigMgr     As SldWorks.ConfigurationManager

Dim myOutFile3      As Scripting.TextStream

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

If swModel.GetType = 1 Then 'When Part

Set swPart = swModel

End If

Set swModelExt = swModel.Extension

Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

Set swConfigPropMgr = swModel.Extension.CustomPropertyManager("")

Set swConfigMgr = swModel.ConfigurationManager

Set swConfig = swConfigMgr.ActiveConfiguration

Dim fso As Scripting.FileSystemObject

Dim sFilePath As String

Set fso = CreateObject("Scripting.FileSystemObject")

sFilePath = "C:\TEMP\PropertiesAndSize.txt"

Set myOutFile3 = fso.OpenTextFile(sFilePath, ForWriting, Create:=True)

'---------------------------------------------------------------------------------------------------------------------------------

myOutFile3.WriteLine ""

myOutFile3.WriteLine "-----Get custom properties"

Debug.Print ""

Debug.Print "-----Get custom properties"

'---------------------------------------------------------------------------------------------------------------------------------

           

Dim CustomCount As String

CustomCount = swCustPropMgr.Count

Dim CustomNames As Variant

CustomNames = swCustPropMgr.GetNames

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Total Number of Custom Properties: " & CustomCount

        Debug.Print ""

        Debug.Print "Total Number of Custom Properties: " & CustomCount

If swModel.GetType = 1 Or swModel.GetType = 2 Then 'When Part or Assembly

        swCustPropMgr.Get3 "DescriptionEN", False, DescriptionENValue, DescriptionENResValue

        swCustPropMgr.Get3 "DescriptionDE", False, DescriptionDEValue, DescriptionDEResValue

        swCustPropMgr.Get3 "DescriptionFR", False, DescriptionFRValue, DescriptionFRResValue

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "This is a Part or Assembly File"

        Debug.Print ""

        Debug.Print "This is a Part or Assembly File"

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property DescriptionEN = " & DescriptionENValue

        myOutFile3.WriteLine "                                 Resolved Value = " & DescriptionENResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property DescriptionEN = " & DescriptionENValue

        Debug.Print "                                 Resolved Value = " & DescriptionENResValue

       

       

        myOutFile3.WriteLine "Current Value for Custom Property DescriptionDE = " & DescriptionDEValue

        myOutFile3.WriteLine "                                 Resolved Value = " & DescriptionDEResValue

       

        Debug.Print "Current Value for Custom Property DescriptionDE = " & DescriptionDEValue

        Debug.Print "                                 Resolved Value = " & DescriptionDEResValue

       

       

        myOutFile3.WriteLine "Current Value for Custom Property DescriptionFR = " & DescriptionFRValue

        myOutFile3.WriteLine "                                 Resolved Value = " & DescriptionFRResValue

       

        Debug.Print "Current Value for Custom Property DescriptionFR = " & DescriptionFRValue

        Debug.Print "                                 Resolved Value = " & DescriptionFRResValue

End If 'When Part or Assembly

       

If swModel.GetType = 3 Then 'When Drawing

        swCustPropMgr.Get3 "Quantity", False, QuantityValue, QuantityResValue

        swCustPropMgr.Get3 "Drawn", False, DrawnValue, DrawnResValue

        swCustPropMgr.Get3 "Modified", False, ModifiedValue, ModifiedResValue

        swCustPropMgr.Get3 "Revision", False, RevisionValue, RevisionResValue

        swCustPropMgr.Get3 "ShowConfig", False, ShowConfigValue, ShowConfigResValue

        swCustPropMgr.Get3 "Note", False, NoteValue, NoteResValue

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "This is a Drawing File"

        Debug.Print ""

        Debug.Print "This is a Drawing File"

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property Quantity = " & QuantityValue

        myOutFile3.WriteLine "                            Resolved Value = " & QuantityResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property Quantity = " & QuantityValue

        Debug.Print "                            Resolved Value = " & QuantityResValue

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property Drawn = " & DrawnValue

        myOutFile3.WriteLine "                         Resolved Value = " & DrawnResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property Drawn = " & DrawnValue

        Debug.Print "                         Resolved Value = " & DrawnResValue

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property Modified = " & ModifiedValue

        myOutFile3.WriteLine "                            Resolved Value = " & ModifiedResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property Modified = " & ModifiedValue

        Debug.Print "                            Resolved Value = " & ModifiedResValue

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property Revision = " & RevisionValue

        myOutFile3.WriteLine "                            Resolved Value = " & RevisionResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property Revision = " & RevisionValue

        Debug.Print "                            Resolved Value = " & RevisionResValue

       

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property ShowConfig = " & ShowConfigValue

        myOutFile3.WriteLine "                              Resolved Value = " & ShowConfigResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property ShowConfig = " & ShowConfigValue

        Debug.Print "                              Resolved Value = " & ShowConfigResValue

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Current Value for Custom Property Note = " & NoteValue

        myOutFile3.WriteLine "                        Resolved Value = " & NoteResValue

        Debug.Print ""

        Debug.Print "Current Value for Custom Property Note = " & NoteValue

        Debug.Print "                        Resolved Value = " & NoteResValue

End If 'When Drawing

'---------------------------------------------------------------------------------------------------------------------------------

myOutFile3.WriteLine ""

myOutFile3.WriteLine "-----Get Configuration Specific Custom Properties for Part or Assembly file"

Debug.Print ""

Debug.Print "-----Get Configuration Specific Custom Properties for Part or Assembly file"

'---------------------------------------------------------------------------------------------------------------------------------

If Not swModel.GetType = 3 Then 'When no Drawing

        Dim retvalConfigCount As String

       

        retvalConfig = swModel.GetConfigurationNames()

        retvalConfigCount = swModel.GetConfigurationCount

        CustomCount = swConfigPropMgr.Count

       

        ReDim ConfigPartNoValue(UBound(retvalConfig))

        ReDim ConfigPartNoResValue(UBound(retvalConfig))

        Dim ActiveConfig As String

        ActiveConfig = "No"

        Set swConfigPropMgr = swModel.Extension.CustomPropertyManager(swConfig.Name)

        swConfigPropMgr.Get3 "ConfigPartNo", False, value, ActiveConfigPartNo 'As Resolved Value

                myOutFile3.WriteLine ""

                myOutFile3.WriteLine "Number of configurations: " & retvalConfigCount

                myOutFile3.WriteLine "Active Configuration: " & swConfig.Name

                myOutFile3.WriteLine "ActiveConfigPartNo: " & ActiveConfigPartNo

                myOutFile3.WriteLine ""

                Debug.Print ""

                Debug.Print "Number of configurations: " & retvalConfigCount

                Debug.Print "Active Configuration: " & swConfig.Name

                Debug.Print "ActiveConfigPartNo: " & ActiveConfigPartNo

                Debug.Print ""

   

    For k = 0 To UBound(retvalConfig)

   

    myOutFile3.WriteLine "Configuration name (retvalconfig): " & retvalConfig(k)

    Debug.Print "Configuration name (retvalconfig): " & retvalConfig(k)

        

    Set swConfigPropMgr = swModel.Extension.CustomPropertyManager(retvalConfig(k))

    swConfigPropMgr.Get3 "ConfigPartNo", False, ConfigPartNoValue(k), ConfigPartNoResValue(k)

  

    myOutFile3.WriteLine "ConfigPartNoResValue = " & ConfigPartNoResValue(k)

    Debug.Print "ConfigPartNoResValue = " & ConfigPartNoResValue(k)

    'Next

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    If swModel.GetType = 1 Then 'When Part

                ActiveConfigMaterial = swPart.GetMaterialPropertyName2(retvalConfig(k), swMatDB)

                myOutFile3.WriteLine "Current Material = " & ActiveConfigMaterial

                myOutFile3.WriteLine ""

                Debug.Print "Current Material = " & ActiveConfigMaterial

                Debug.Print ""

    End If

        'Get weight for active configuration

        ActiveConfigWeight = swModelExt.GetMassProperties(1, nStatus)

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "GetMassProperties"

        Debug.Print ""

        Debug.Print "GetMassProperties"

        WeightData = "No Data"

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "  Status = " & nStatus

        myOutFile3.WriteLine ""

        Debug.Print ""

        Debug.Print "  Status = " & nStatus

        Debug.Print ""

        If nStatus = 0 Then

        If Not IsEmpty(ActiveConfigWeight) Then

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "  CenterOfMassX = " & ActiveConfigWeight(0)

        myOutFile3.WriteLine "  CenterOfMassY = " & ActiveConfigWeight(1)

        myOutFile3.WriteLine "  CenterOfMassZ = " & ActiveConfigWeight(2)

        myOutFile3.WriteLine "  Volume = " & ActiveConfigWeight(3)

        myOutFile3.WriteLine "  Area   = " & ActiveConfigWeight(4)

        myOutFile3.WriteLine "  Mass   = " & ActiveConfigWeight(5)

        myOutFile3.WriteLine "  Mass   = " & ActiveConfigWeight(5)

        myOutFile3.WriteLine "  MomXX = " & ActiveConfigWeight(6)

        myOutFile3.WriteLine "  MomYY = " & ActiveConfigWeight(7)

        myOutFile3.WriteLine "  MomZZ = " & ActiveConfigWeight(8)

        myOutFile3.WriteLine "  MomXY = " & ActiveConfigWeight(9)

        myOutFile3.WriteLine "  MomZX = " & ActiveConfigWeight(10)

        myOutFile3.WriteLine "  MomYZ = " & ActiveConfigWeight(11)

        End If

        WeightData = Format(ActiveConfigWeight(5), "#,##0.00") & " kg"

        myOutFile3.WriteLine ""

        myOutFile3.WriteLine "Weight Active Configuration = " & WeightData

        myOutFile3.WriteLine ""

        Debug.Print ""

        Debug.Print "Weight Active Configuration = " & WeightData

        Debug.Print ""

        End If

ActiveConfigMaterial = swPart.GetMaterialPropertyName2(retvalConfig(k), swMatDB)

Next

'---------------------------------------------------------------------------------------------------------------------------------

myOutFile3.WriteLine ""

myOutFile3.WriteLine "-----Get Size information"

Debug.Print ""

Debug.Print "-----Get Size information"

'---------------------------------------------------------------------------------------------------------------------------------

' Set userform fields and their values, Textbox Size is filled with actual found dimension values based on Dimension Name

' Valid Dimension Name combinations are:

' Ø'OD' x L='L'

' Ø'OD' x Ø'ID' x L='L'

' Ø'OD' x 'T'(Ø'ID') x L='L'

' 'L' x 'B' x 'H'

' 'L' x 'B' x 'Thickness'

' 'L' x 'H' x 'Thickness'

Dim swFeat                  As SldWorks.Feature

Dim swSubFeat               As SldWorks.Feature

Dim swDispDim               As SldWorks.DisplayDimension

Dim swDim                   As SldWorks.Dimension

Dim swAnn                   As SldWorks.Annotation

Dim bRet                    As Boolean

Dim z                       As Integer

Dim MyControl As Control

Set swFeat = swModel.FirstFeature

Debug.Print "swFeat = " & swFeat.Name

Do While Not swFeat Is Nothing '1st Loop

       

If swFeat.Name <> "Comments" And _

swFeat.Name <> "Sensors" And _

swFeat.Name <> "Tables1" And _

swFeat.Name <> "Design Binder" And _

swFeat.Name <> "Annotations" And _

swFeat.Name <> "Detail Folder1" And _

swFeat.Name <> "Detail Folder2" And _

swFeat.Name <> "Surface Bodies" And _

swFeat.Name <> "Solid Bodies" And _

swFeat.Name <> "Lights, Cameras and Scene" And _

swFeat.Name <> "Ambient" And _

swFeat.Name <> "Directional1" And _

swFeat.Name <> "Directional2" And _

swFeat.Name <> "Directional3" And _

swFeat.Name <> "Equations" And _

swFeat.Name <> "ABS PC" And _

swFeat.Name <> "Front Plane" And _

swFeat.Name <> "Top Plane" And _

swFeat.Name <> "Right Plane" And _

swFeat.Name <> "Origin" And _

swFeat.Name <> "Tables" And _

swFeat.Name <> "Axis1" And _

swFeat.Name <> "Axis2" And _

swFeat.Name <> "Axis3" Then

 

myOutFile3.WriteLine ""

myOutFile3.WriteLine "       swFeat.Name = " & swFeat.Name

myOutFile3.WriteLine "  swFeat.CreatedBy = " & swFeat.CreatedBy

myOutFile3.WriteLine "swFeat.DateCreated = " & swFeat.DateCreated

Debug.Print ""

Debug.Print "       swFeat.Name = " & swFeat.Name

Debug.Print "  swFeat.CreatedBy = " & swFeat.CreatedBy

Debug.Print "swFeat.DateCreated = " & swFeat.DateCreated

End If

          

        Set swDispDim = swFeat.GetFirstDisplayDimension

        Dim DimName As String

        Set swSubFeat = swFeat.GetNextSubFeature

        Set swDispDim = swFeat.GetFirstDisplayDimension

        Do While Not swDispDim Is Nothing '2nd Loop

            Set swAnn = swDispDim.GetAnnotation

            Set swDim = swDispDim.GetDimension

            myOutFile3.WriteLine "swDim.FullName = " & swDim.FullName & "                Value = " & swDim.GetSystemValue2("") * 1000

            Debug.Print "swDim.FullName = " & swDim.FullName & "                Value = " & swDim.GetSystemValue2("") * 1000

            DimName = swDim.Name

            If DimName = "OD" Or DimName = "od" Then

                ODString = Chr(34) + swDim.FullName + Chr(34)

                ODValue = swDim.GetSystemValue2("") * 1000

                ODValue = Format(ODValue, "#,##0.00")

                    myOutFile3.WriteLine "OD String = " & ODString

                    myOutFile3.WriteLine "OD Value = " & ODValue

                    Debug.Print "OD String = " & ODString

                    Debug.Print "OD Value = " & ODValue

            ElseIf DimName = "L" Or DimName = "l" Then

                LString = Chr(34) + swDim.FullName + Chr(34)

                LValue = swDim.GetSystemValue2("") * 1000

                LValue = Format(LValue, "#,##0.00")

                    myOutFile3.WriteLine "L String = " & LString

                    myOutFile3.WriteLine "L Value = " & LValue

                    Debug.Print "L String = " & LString

                    Debug.Print "L Value = " & LValue

            ElseIf DimName = "T" Or DimName = "t" Then

                TString = Chr(34) + swDim.FullName + Chr(34)

                TValue = swDim.GetSystemValue2("") * 1000

                TValue = Format(TValue, "#,##0.00")

                    myOutFile3.WriteLine "T String = " & TString

                    myOutFile3.WriteLine "T Value = " & TValue

                    Debug.Print "T String = " & TString

                    Debug.Print "T Value = " & TValue

            ElseIf DimName = "ID" Or DimName = "id" Then

                IDString = Chr(34) + swDim.FullName + Chr(34)

                IDValue = swDim.GetSystemValue2("") * 1000

                IDValue = Format(IDValue, "#,##0.00")

                    myOutFile3.WriteLine "ID String = " & IDString

                    myOutFile3.WriteLine "ID Value = " & IDValue

                    Debug.Print "ID String = " & IDString

                    Debug.Print "ID Value = " & IDValue

            ElseIf DimName = "B" Or DimName = "b" Then

                BString = Chr(34) + swDim.FullName + Chr(34)

                BValue = swDim.GetSystemValue2("") * 1000

                BValue = Format(BValue, "#,##0.00")

                    myOutFile3.WriteLine "B String = " & BString

                    myOutFile3.WriteLine "B Value = " & BValue

                    Debug.Print "B String = " & BString

                    Debug.Print "B Value = " & BValue

            ElseIf DimName = "H" Or DimName = "h" Then

                HString = Chr(34) + swDim.FullName + Chr(34)

                HValue = swDim.GetSystemValue2("") * 1000

                HValue = Format(HValue, "#,##0.00")

                    myOutFile3.WriteLine "H String = " & HString

                    myOutFile3.WriteLine "H Value = " & HValue

                    Debug.Print "H String = " & HString

                    Debug.Print "H Value = " & HValue

            ElseIf DimName = "Thickness" Or DimName = "thickness" Then

                ThicknessString = Chr(34) + swDim.FullName + Chr(34)

                ThicknessValue = swDim.GetSystemValue2("") * 1000

                ThicknessValue = Format(ThicknessValue, "#,##0.00")

                    myOutFile3.WriteLine "Thickness String = " & ThicknessString

                    myOutFile3.WriteLine "Thickness Value = " & ThicknessValue

                    Debug.Print "Thickness String = " & ThicknessString

                    Debug.Print "Thickness Value = " & ThicknessValue

           

            ElseIf DimName = "Diameter" Or DimName = "diameter" Then

                DiameterString = Chr(34) + swDim.FullName + Chr(34)

                DiameterValue = swDim.GetSystemValue2("") * 1000

                DiameterValue = Format(DiameterValue, "#,0")

                    myOutFile3.WriteLine "Diameter String = " & DiameterString

                    myOutFile3.WriteLine "Diameter Value = " & DiameterValue

                    Debug.Print "Diameter String = " & DiameterString

                    Debug.Print "Diameter Value = " & DiameterValue

            ElseIf DimName = "Length" Or DimName = "length" Then

                LengthString = Chr(34) + swDim.FullName + Chr(34)

                LengthValue = swDim.GetSystemValue2("") * 1000

                LengthValue = Format(LengthValue, "#,0")

                    myOutFile3.WriteLine "Length String = " & LengthString

                    myOutFile3.WriteLine "Length Value = " & LengthValue

                    Debug.Print "Length String = " & LengthString

                    Debug.Print "Length Value = " & LengthValue

            End If

            Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)

            Loop '2nd Loop

            Set swFeat = swFeat.GetNextFeature

Loop '1st Loop

'---------------------------------------------------------------------------------------------------------------------------------

myOutFile3.WriteLine ""

myOutFile3.WriteLine "-----Set SizeDataString for Custom Property Size and SizeDataValue for Userform"

Debug.Print ""

Debug.Print "-----Set SizeDataString for Custom Property Size and SizeDataValue for Userform"

'---------------------------------------------------------------------------------------------------------------------------------

    If ODString = "" And LString = "" And TString = "" And IDString = "" And BString = "" And HString = "" And ThicknessString = "" And DiameterString = "" And LengthString = "" Then

SizeDataValue = "No Valid Size Parameters found !"

' Ø'OD' x L='L'

ElseIf ODString > "" And LString > "" And TString = "" And IDString = "" And BString = "" And HString = "" And ThicknessString = "" And DiameterString = "" And LengthString = "" Then

SizeDataString = "Ø" & ODString & " x L=" & LString

SizeDataValue = "Ø" & ODValue & " x L= " & LValue

' Ø'OD' x Ø'ID' x L='L'

ElseIf ODString > "" And LString > "" And TString = "" And IDString > "" And BString = "" And HString = "" And ThicknessString = "" And DiameterString = "" And LengthString = "" Then

SizeDataString = "Ø" & ODString & " x Ø" & IDString & " x L=" & LString

SizeDataValue = "Ø" & ODValue & " x Ø" & IDValue & " x L=" & LValue

' Ø'OD' x 'T'(Ø'ID') x L='L'

ElseIf ODString > "" And LString > "" And TString > "" And IDString > "" And BString = "" And HString = "" And ThicknessString = "" And DiameterString = "" And LengthString = "" Then

SizeDataString = "Ø" & ODString & " x " & TString & "(Ø" & IDString & ")x L=" & LString

SizeDataValue = "Ø" & ODValue & " x " & TValue & "(Ø" & IDValue & ")x L= " & LValue

' 'L' x 'B' x 'H'

ElseIf ODString = "" And LString > "" And TString = "" And IDString = "" And BString > "" And HString > "" And ThicknessString = "" And DiameterString = "" And LengthString = "" Then

SizeDataString = LString & " x " & BString & " x " & HString

SizeDataValue = LValue & " x " & BValue & " x " & HValue

' 'L' x 'B' x #'Thickness'

ElseIf ODString = "" And LString > "" And TString = "" And IDString = "" And BString > "" And HString = "" And ThicknessString > "" And DiameterString = "" And LengthString = "" Then

SizeDataString = LString & " x " & BString & " x #" & ThicknessString

SizeDataValue = LValue & " x " & BValue & " x #" & ThicknessValue

' 'L' x 'H' x #'Thickness'

ElseIf ODString = "" And LString > "" And TString = "" And IDString = "" And BString = "" And HString > "" And ThicknessString > "" And DiameterString = "" And LengthString = "" Then

SizeDataString = LString & " x " & HString & " x #" & ThicknessString

SizeDataValue = LValue & " x " & HValue & " x #" & ThicknessValue

ElseIf ODString = "" And LString = "" And TString = "" And IDString = "" And BString = "" And HString = "" And ThicknessString = "" And DiameterString <> "" And LengthString <> "" Then

SizeDataString = "M" & DiameterString & " x " & LengthString

SizeDataValue = "M" & DiameterValue & " x " & LengthValue

ElseIf SizeDataString = "" Then

SizeDataValue = "Not enough Size Parameters found"

End If

myOutFile3.WriteLine ""

myOutFile3.WriteLine "  SizeDataString: " & SizeDataString

myOutFile3.WriteLine "   SizeDatavalue: " & SizeDataValue

Debug.Print ""

Debug.Print "   SizeDataString : " & SizeDataString

Debug.Print "   SizeDatavalue  : " & SizeDataValue

End If 'If Not swModel.GetType = 3 Then 'When no Drawing

'Close myOutFile3

myOutFile3.Close

Set myOutFile3 = Nothing

Set fso = Nothing

Debug.Print ""

Debug.Print "End Module GetPropertiesAndSize and return to Initialize in Userform"

End Sub

SolidworksApi macros