My version of the function how to correctly get all the components of an assembly from all its configurations. I get all the component data in a Dictionary with several attachments. A component here is a part or an assembly (you can add a filter if you need one).
First-level keys - These are full paths to the component model file (this is a fairly unique identifier (unsaved ones get “NotSaved[” & ModelDoc2.GetTitle & “]”, and virtual ones get the path to a temporary file in the SV-temp folder))
Second-level keys - This is the configuration of the component that occurs in the assembly (if the component has 10 configurations, and only 2 of them are used in the assembly, then only 2 will be in the dictionary).
Third-level keys are the names of the parameters: States in the Assembly, special properties, User Properties.
Values - these are actually the values of these properties.
I added the PrintPRP Function that displays the received properties for a given component, as well as auxiliary functions so that the entire model works at once.
*I mentioned in the comments about component states in the context of the build that you can organize a triple state for example: True, False and Zero or organize another level of complexity (Build Configuration Name)(Component Path)(Component Configuration Name)(Parameter Name){Value}
Improvements and additions are welcome.
' Macro: Extract All Components from All Configurations in an Assembly
' Description: Traverses all configurations of the top-level assembly and collects components and their configuration data.
Public ASM_CON_NAMES As Variant ' Array of configuration names
Public DIC_AllComp As Object ' Dictionary to hold all components and their configurations
Sub Main_ExtractAllComponents()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim AsmConfsMgr As SldWorks.ConfigurationManager
Dim AsmActiveConfName As String
Dim ResolveAllAns As Integer
Dim iASM As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocASSEMBLY Then Exit Sub
Set swAssy = swModel
Set AsmConfsMgr = swModel.ConfigurationManager
AsmActiveConfName = AsmConfsMgr.ActiveConfiguration.Name
ASM_CON_NAMES = GetConfWithActvFirst(swAssy, AsmActiveConfName)
ResolveAllAns = swAssy.ResolveAllLightWeightComponents(True)
If ResolveAllAns <> 0 Then
Select Case ResolveAllAns
Case 1: Debug.Print "Resolution aborted by user"
Case 2: Debug.Print "Some components could not be resolved"
Case 3: Debug.Print "Components were not resolved"
Case Else: Debug.Print "Resolution did not occur"
End Select
End If
'Multi-level dictionary for storing properties: Key1 - full path to file, Key2 - Configuration name, "Key3" - parameter name, "Value" - parameter value.
Set DIC_AllComp = CreateObject("Scripting.Dictionary")
For iASM = 0 To UBound(ASM_CON_NAMES)
If iASM > 0 Then
If swModel.ShowConfiguration2(ASM_CON_NAMES(iASM)) Then swModel.ForceRebuild3 (True)
End If
Dim vComps As Variant
vComps = swAssy.GetComponents(False)
If IsEmpty(vComps) Then GoTo NextASMConf
Dim iComp As Long
For iComp = LBound(vComps) To UBound(vComps)
Dim swComp As SldWorks.Component2
Dim swMod As SldWorks.ModelDoc2
Set swComp = vComps(iComp)
If Not swComp Is Nothing Then
If swComp.IsSuppressed = False Then 'If the component is not extinguished This check can be removed if it is necessary to process extinguished files **1
Call ProcessComp(swComp, swMod)
End If
End If
Next iComp
NextASMConf:
Next iASM
End Sub
Function ProcessComp(swComInAsm As SldWorks.Component2, swComMD2 As SldWorks.ModelDoc2) As Integer
ProcessComp = 0
Dim Key_FilePathName As String
Dim CompConfNames As Variant
Set swComMD2 = swComInAsm.GetModelDoc2
If swComMD2 Is Nothing Then Exit Function
Key_FilePathName = swComMD2.GetPathName
If Key_FilePathName = "" Then Key_FilePathName = "NotSaved[" & swComMD2.GetTitle & "]"
Dim CompConfNameInAsm As String
CompConfNameInAsm = swComInAsm.ReferencedConfiguration
' CompConfNames = GetConfWithActvFirst(swComMD2, CompConfNameInAsm, "SM-FLAT-PATTERN")
' If IsEmpty(CompConfNames) Then Exit Function
' Dim iConf As Long
' For iConf = 0 To UBound(CompConfNames)
' If iConf > 0 Then swComMD2.ShowConfiguration2 CompConfNames(iConf)
If DIC_AllComp.Exists(Key_FilePathName) Then
If DIC_AllComp(Key_FilePathName).Exists(CompConfNameInAsm) Then GoTo NextConfComp
DIC_AllComp(Key_FilePathName).Add CompConfNameInAsm, GetAllConfPrp(swComInAsm, swComMD2, CompConfNameInAsm)
Else
DIC_AllComp.Add Key_FilePathName, MakeConfDic(swComInAsm, swComMD2, CompConfNameInAsm)
End If
If DIC_AllComp(Key_FilePathName).Exists(CompConfNameInAsm) Then
If Not IsEmpty(DIC_AllComp(Key_FilePathName)(CompConfNameInAsm)) Then
If TypeName(DIC_AllComp(Key_FilePathName)(CompConfNameInAsm)) = "Dictionary" Then
If PrintPRP(Key_FilePathName, CompConfNameInAsm) = True Then
ProcessComp = ProcessComp + 1
End If
End If
End If
End If
NextConfComp:
' Next iConf
End Function
'Function to create a nested dictionary
Function MakeConfDic(Comp2 As SldWorks.Component2, Mod2 As SldWorks.ModelDoc2, ByVal ActiveConfigurationName As String) As Object
Dim DIC_conf As Object
Set DIC_conf = CreateObject("Scripting.Dictionary")
DIC_conf.Add ActiveConfigurationName, GetAllConfPrp(Comp2, Mod2, ActiveConfigurationName)
Set MakeConfDic = DIC_conf
End Function
' Function for directly getting properties for a specific component configuration
Function GetAllConfPrp(Comp2 As SldWorks.Component2, Mod2 As SldWorks.ModelDoc2, ByVal ActiveConfigurationName As String) As Object
Dim DIC_PRP As Object
Set DIC_PRP = CreateObject("Scripting.Dictionary")
' Component states in the assembly (they do not exist outside the assembly context) respectively the same component can be (in different or not in different assembly configurations)
'both Virtual and non-virtual, both a converter and not a converter, therefore such obtaining of properties is not entirely correct. It will be correct to obtain: Triple state,
'for example for an Envelope: Always only NOT an envelope, Always only an envelope or can be both an envelope and not a converter. It is possible to store in which assembly configurations which states are present.
If Not Comp2 Is Nothing Then
DIC_PRP.Add "Component2", Comp2 'Store a reference to an object in an assembly
DIC_PRP.Add "Name2", Comp2.Name2 'Get the name of the component in the assembly (subAssem1-2/Part1-1)
DIC_PRP.Add "IsSuppressed", Comp2.IsSuppressed 'Suppressed or not in the Assembly (this can be left if there is no check for Suppressed files in the context of the "For iComp" cycle)**1
DIC_PRP.Add "IsVirtual", Comp2.IsVirtual 'Virtual or not
DIC_PRP.Add "ExcludeFromBOM", Comp2.ExcludeFromBOM 'Excluded from specification in this Build configuration
DIC_PRP.Add "IsEnvelope", Comp2.IsEnvelope 'envelope
End If
Dim filename As String
If Not Mod2 Is Nothing Then
If DIC_PRP.Exists("IsVirtual") Then
If DIC_PRP("IsVirtual") Then
filename = Mod2.GetTitle
Else
filename = GetFileNameWithoutExtension(Mod2.GetPathName)
End If
Else
filename = GetFileNameWithoutExtension(Mod2.GetPathName)
End If
'=======================================================================================================
DIC_PRP.Add "ModelDoc2", Mod2
DIC_PRP.Add "FileName", filename
DIC_PRP.Add "GetType", Mod2.GetType '1-PART; 2 - ASM
DIC_PRP.Add "IsRollback", ISRollBack(Mod2)
DIC_PRP.Add "ISToolboxPartType", ISToolboxPartType(Mod2)
DIC_PRP.Add "IsSheetMetal", IsSheetMetalByGetBendState(Mod2)
'There can be a function to read any parameters from the ActiveConfigurationName component configuration and add them to the DIC_PRP dictionary
DIC_PRP.Add "SomePRP", "ValueOfPRP in " & ActiveConfigurationName
End If
Set GetAllConfPrp = DIC_PRP
End Function
'============= AUXILIARY FUNCTIONS =============================
'We find all the names of the configurations and return them in an array where ActiveConf is the first
Function GetConfWithActvFirst(Mod2 As SldWorks.ModelDoc2, FirstConfName As String, Optional NoSubStr As String = "") As Variant
Dim swConfMgr As SldWorks.ConfigurationManager
Dim confNameArray As Variant
Dim activeConfName As String
Dim confNamesList As Collection
Dim i As Long
Dim GoTestNoSubStr As Boolean
confNameArray = Mod2.GetConfigurationNames
If FirstConfName <> "" Then
activeConfName = FirstConfName
Else
activeConfName = Mod2.ConfigurationManager.ActiveConfiguration.Name
End If
Set confNamesList = New Collection
GoTestNoSubStr = (NoSubStr <> "")
If GoTestNoSubStr And InStr(activeConfName, NoSubStr) > 0 Then
confNamesList.Add ""
Else
confNamesList.Add activeConfName
End If
For i = LBound(confNameArray) To UBound(confNameArray)
If confNameArray(i) <> activeConfName Then
If GoTestNoSubStr = False Or InStr(confNameArray(i), NoSubStr) = 0 Then
confNamesList.Add confNameArray(i)
End If
End If
Next i
Dim confNamesArray() As Variant
ReDim confNamesArray(0 To confNamesList.Count - 1)
For i = 1 To confNamesList.Count
confNamesArray(i - 1) = confNamesList(i)
Next i
GetConfWithActvFirst = confNamesArray
End Function
'Authentic sheet metal
Function IsSheetMetalByGetBendState(ByVal swModel As SldWorks.ModelDoc2) As Boolean
Dim nBendState As Long
nBendState = swModel.GetBendState
IsSheetMetalByGetBendState = (nBendState <> swSMBendStateNone)
End Function
'Component with tree in rollback state
Function ISRollBack(Mod2 As SldWorks.ModelDoc2) As Boolean
Dim swFeat As SldWorks.Feature
Set swFeat = Mod2.FirstFeature
Do While Not swFeat Is Nothing
If swFeat.IsRolledBack Then
ISRollBack = True
Exit Function
End If
Set swFeat = swFeat.GetNextFeature
Loop
ISRollBack = False
End Function
'Toolbox component (not to be confused with the "IsFastener" property)
Function ISToolboxPartType(Mod2 As SldWorks.ModelDoc2) As Boolean
Dim swModelExt As SldWorks.ModelDocExtension
Set swModelExt = Mod2.Extension
ISToolboxPartType = (swModelExt.ToolboxPartType <> swToolBoxPartType_e.swNotAToolboxPart)
End Function
Public Function GetFileNameWithoutExtension(ByVal path As String) As String
If path = "" Or InStrRev(path, "\") = 0 Then
GetFileNameWithoutExtension = ""
Else
GetFileNameWithoutExtension = Mid(path, InStrRev(path, "\") + 1, InStrRev(path, ".") - InStrRev(path, "\") - 1)
End If
End Function
Function PrintPRP(ByVal Key_FilePathName As String, ByVal ConfName As String) As Boolean
On Error Resume Next
Dim dicPRP As Object
Set dicPRP = DIC_AllComp(Key_FilePathName)(ConfName)
If dicPRP Is Nothing Then Exit Function
Debug.Print "File: " & Key_FilePathName & " | Config: " & ConfName
Dim k
For Each k In dicPRP.Keys
If TypeName(dicPRP(k)) <> "Object" Then
Debug.Print " " & k & " = " & dicPRP(k)
End If
Next k
PrintPRP = True
End Function