Remove Textures from Assembly Components Example (VBA)
This example shows how to remove all textures from all components in
an assembly.
'-------------------------------------------------
'
' Preconditions: An assembly document is open and at least
one component
' had
a texture applied to it at the component level.
' Postconditions: All textures applied to components are
removed.
'
'--------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim SelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Function RemoveTexture(swDoc As SldWorks.ModelDoc2, configName
As String) As Boolean
Dim
swDocExt As SldWorks.ModelDocExtension
Dim
swTexture As SldWorks.Texture
Set
swDocExt = swDoc.Extension
Set
swTexture = swDocExt.GetTexture(configName)
If
Not swTexture Is Nothing Then
Debug.Print
"", "Texture removed: ", swTexture.MaterialName
RemoveTexture
= swDocExt.RemoveTexture2(configName)
swDoc.SetSaveFlag
End
If
End Function
Function TraverseComponents(parentComp As SldWorks.Component2)
Dim
vChildComponents As Variant
Dim
vObj As Variant
Dim
childComp As SldWorks.Component2
Dim
childDoc As SldWorks.ModelDoc2
Dim
childConfigName As String
vChildComponents
= parentComp.GetChildren
For
Each vObj In vChildComponents
Set
childComp = vObj
Set
childDoc = childComp.GetModelDoc
childConfigName
= childComp.ReferencedConfiguration
Debug.Print
childComp.Name2, childConfigName
boolstatus
= RemoveTexture(childDoc, childConfigName)
Call
TraverseComponents(childComp)
Next
vObj
End Function
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Dim rootDoc As SldWorks.ModelDoc2
Dim rootConfig As SldWorks.Configuration
Dim rootComp As SldWorks.Component2
Dim configMgr As SldWorks.ConfigurationManager
Set rootDoc = swApp.ActiveDoc
Set configMgr = Part.ConfigurationManager
Set rootConfig = configMgr.ActiveConfiguration
Set rootComp = rootConfig.GetRootComponent
Call TraverseComponents(rootComp)
End Sub