AnsweredAssumed Answered

Macro to run through assemblies and sub assemblies

Question asked by Nathan McCluskey on Nov 4, 2020
Latest reply on Nov 10, 2020 by Amen Allah Jlili

Hello,

 

I have the below frankensteined macro that transfer the configuration description into a custom property called 'Title',  it then brings to model into view and saves it. The reason for this is my drawing title then matches the BOM description in the assembly drawings.

 

I was hoping that it if the file was just a part it would transfer each configuration and is the file was an assembly it would work through each configuration for the assembly then move to the sub assemblies and part and do the same. 

 

I believe it is my misunderstanding for the parent and children section of the code.

 

Could somebody point me in the correct direct to update the code to cycle through each sub item in the open file?

 

'-------------------------------------------
' Preconditions: Part or assembly is open.
' Postconditions: The model is zoomed to fit in the graphics area,
' and the document is saved.
' NOTE: Configurations are not supported on drawings
'--------------------------------------------
Option Explicit

Sub main()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfig, swParentConfig, swChildConfig As SldWorks.Configuration
Dim swConfMgr As SldWorks.ConfigurationManager
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vConfigNameArr, vConfigName, vChildConfigArr, vChildConfig, vCustInfoNameArr, vCustInfoName As Variant
Dim i, RetVal As Long
Dim bRet, boolstatus As Boolean
Dim Des, Value As String
Dim lErrors As Long
Dim lWarnings As Long

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swConfMgr = swModel.ConfigurationManager
Set swConfig = swConfMgr.ActiveConfiguration
'Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

' Always at least one configuration will exist
vConfigNameArr = swModel.GetConfigurationNames
For Each vConfigName In vConfigNameArr

Set swConfig = swModel.GetConfigurationByName(vConfigName)
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(vConfigName)

'Set Des varible to the current configuartions description
Des = swConfig.Description

'Either Adds a Title Property or updated the current one.
swCustPropMgr.Add3 "Title", swCustomInfoType_e.swCustomInfoText, Des, 2

 

' Process parent
Set swParentConfig = swConfig.GetParent
If Not swParentConfig Is Nothing Then
End If

 

' Process children
vChildConfigArr = swConfig.GetChildren
If Not IsEmpty(vChildConfigArr) Then
For Each vChildConfig In vChildConfigArr
Set swChildConfig = vChildConfig

 

Next

End If

Next

'Saves file after update
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swApp.Visible = True
' Make a change
swModel.ViewZoomtofit2

boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
' Errors
Debug.Print ("Errors as defined in swFileSaveError_e: " & lErrors)
' Warnings
Debug.Print ("Warnings as defined in swFileSaveWarning_e: " & lWarnings)

End Sub

Outcomes