Robert Tupa

VBA get properties from different configurations of same part

Discussion created by Robert Tupa on Sep 23, 2019
Latest reply on Sep 24, 2019 by Josh Brady

Been racking my brain on this one.  Amature VBA programmer at best.  I've pieced together this code thanks to many helpful contributors on this forum.  The intent is to grab custom and configuration specific properties in tab delimited form to clipboard.  The idea is to pick a few parts in an assembly that I need to order, run the macro, and paste to an email or spreadsheet.  It works great except for one thing.


If I pick multiples of the same part (but different configurations) it always returns the same properties for both.  If I run the macro on the parts individually, the returned properties are correct for the part selected.


Help!  And please forgive my sloppy coding. 



' Macro to copy custom properties of selected assembly components to MS Windows clipboard
' in desired order for pasting to Excel.

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub main()
'On Error GoTo Trap

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelCompModel As SldWorks.ModelDoc2
Dim swSelCompModelExt As ModelDocExtension
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim bRet As Boolean
' Dim GeneralSelObj As Object
Dim i As Integer
Dim CurSelCount As Long
'Dim swSelCompName As String
Dim NewObjToSelect As Object
Dim DwgDocComp As DrawingComponent
Dim OldToggleVal As LongPtr


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc


' Exit if open doc is not assembly or assembly drawing type

If swModel.GetType = swDocPART Then
MsgBox "This macro works on assembly documents or assembly drawings only."
Exit Sub
ElseIf (swModel.GetType = swDocDRAWING) Then
If (swModel.ActiveDrawingView.ReferencedDocument.GetType = swDocPART) Then
MsgBox "This macro works on assembly documents or assembly drawings only."
Exit Sub
End If
End If

' Exit if nothing selected

Set swSelMgr = swModel.SelectionManager

Dim selObjectsCount As Integer
selObjectsCount = swSelMgr.GetSelectedObjectCount2(-1)
If selObjectsCount = 0 Then
MsgBox "Nothing was selected"
Exit Sub
End If

'Traverse selections. If selection component has parent, select parent. If not, select part
For CurSelCount = 1 To selObjectsCount

Set swSelComp = swSelMgr.GetSelectedObjectsComponent4(CurSelCount, -1)

If swSelComp.GetSuppression = swComponentLightweight Then
MsgBox "Check for lightweight parts." & vbCrLf & "Please set selected parts to resolved before running this.", vbInformation
Exit Sub
' swSelComp.SetSuppression2 swComponentResolved
' swModel.Extension.SelectByID2 "swSelCompName", "Component", 0, 0, 0, False, 0, Nothing, 0
' Set swSelComp = swSelMgr.GetSelectedObjectsComponent(1)
End If

Set NewObjToSelect = swSelComp.GetParent
If Not NewObjToSelect Is Nothing Then
swSelMgr.DeSelect2 CurSelCount, -1
If swModel.GetType = swDocDRAWING Then
Set NewObjToSelect = NewObjToSelect.GetDrawingComponent(swSelMgr.GetSelectedObject6(swSelMgr.GetSelectedObjectCount2(-1), -1))
swModel.ClearSelection2 True
OldToggleVal = swApp.GetUserPreferenceToggle(swAutoShowPropertyManager)
swApp.SetUserPreferenceToggle swAutoShowPropertyManager, False
bRet = NewObjToSelect.Select(True, Nothing)
swApp.SetUserPreferenceToggle swAutoShowPropertyManager, OldToggleVal

' Check to see if parent assembly is a purchased part
Set swSelCompModel = NewObjToSelect.GetModelDoc2
Set swConfigMgr = swSelCompModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
' If children are hidden, then its assumed its a purchased part, so select the partent assembly
If swConfig.ChildComponentDisplayInBOM = swChildComponentInBOMOption_e.swChildComponent_Hide Then
NewObjToSelect.Select (True)
swSelComp.Select (True)
End If

End If

'Select the part if it's in your assembly and not a child of a sub assembly
swSelMgr.DeSelect2 CurSelCount, -1 ' (part becomes deselected)
swSelComp.Select (True)
End If


' Traverse new selection set and get custom properties

For CurSelCount = 1 To selObjectsCount
Dim strText As String
Dim bool As Boolean
Dim StockNum As String
Dim PartNum As String
Dim Desc As String
Dim Company As String
Dim Vendor As String
Dim val5 As String
Dim EstCost As String
Dim valout As String

Set swSelComp = swSelMgr.GetSelectedObjectsComponent4(CurSelCount, -1)
' Get configuration specific custom property values
Set swSelCompModel = swSelComp.GetModelDoc2
Set swConfigMgr = swSelCompModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
'Set swCustPropMgr = swConfig.CustomPropertyManager
Set swCustPropMgr = swSelCompModel.Extension.CustomPropertyManager(swConfig.Name)

bool = swCustPropMgr.Get4("Stock Number", False, valout, StockNum)

bool = swCustPropMgr.Get4("Part Number", False, valout, PartNum)
bool = swCustPropMgr.Get4("Description", False, valout, Desc)
' val5 = quantity of component in the assembly
bool = swCustPropMgr.Get4("Estimated Cost", False, valout, EstCost)
'Get general custom property values
'Set swSelCompModelExt = swSelCompModel.Extension
Set swCustPropMgr = swSelCompModel.Extension.CustomPropertyManager("")
bool = swCustPropMgr.Get4("Company", False, valout, Company)
bool = swCustPropMgr.Get4("Vendor", False, valout, Vendor)

strText = strText & StockNum & vbTab & PartNum & vbTab & Desc & vbTab & Company & vbTab & Vendor & vbTab & val5 & vbTab & EstCost & vbCr

Debug.Print strText
Call CopyTextToClipboard(strText)

Exit Sub
If Err.Number = 91 Then
MsgBox "Check for lightweight parts"
MsgBox Err.Description
End If

End Sub