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