Hi,
I have multiple parts (over 100) that need the exact same appereance. Currently I'm doing the following:
- Remove all appearances;
- Right-click the apearance task manager to "add new appearance";
- Select Dark Powder Coat;
- Edit Appearance;
- Give the color
- R0 G0 B255
- H240 S100 V100
- Remap the appearance to:
- Width: 10[mm]
- Height: 10[mm]
I've tried doing it, but the only thing I'm doing is editing the color of the appearance allready in use:
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swDisplayStateSetting As SldWorks.DisplayStateSetting
Dim swComponent As SldWorks.Component2
Dim swComponents(0) As SldWorks.Component2
Dim swConfig As SldWorks.Configuration
Dim displayStateNames(0) As String
Dim appearances As Variant
Dim swAppearanceSetting As SldWorks.AppearanceSetting
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim newAppearances(0) As Object
Dim status As Boolean
Dim errors As Long
Dim warnings As Long
Dim fileName As String
Dim red_rgb As Long
Dim green_rgb As Long
Dim blue_rgb As Long
Dim newColor As Long
Set swApp = Application.SldWorks
'Open the assembly component USB_cover1 as a part document
Set swModelDoc = swApp.ActiveDoc
Set swModelDocExt = swModelDoc.Extension
Set swSelMgr = swModelDoc.SelectionManager
Set swConfigMgr = swModelDoc.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swRenderMaterial = swModelDocExt.CreateRenderMaterial(MaterialName)
Set swComponents(0) = Nothing
Set swComponents(0) = swConfig.GetRootComponent3(True)
swModelDoc.ClearSelection2 True
'Get display state
Set swDisplayStateSetting = Nothing
Set swDisplayStateSetting = swModelDocExt.GetDisplayStateSetting(swAllDisplayState)
swDisplayStateSetting.Entities = swComponents
swDisplayStateSetting.Option = swSpecifyDisplayState
displayStateNames(0) = "<Default>_Display State 1"
swDisplayStateSetting.Names = displayStateNames
appearances = swModelDocExt.DisplayStateSpecMaterialPropertyValues(swDisplayStateSetting)
Set swAppearanceSetting = Nothing
Set swAppearanceSetting = appearances(0)
red_rgb = 0
green_rgb = 0
blue_rgb = 255
newColor = Excel.WorksheetFunction.Max(Excel.WorksheetFunction.Min(red_rgb, 255), 0) + Excel.WorksheetFunction.Max(Excel.WorksheetFunction.Min(green_rgb, 255), 0) * 16 * 16 + Excel.WorksheetFunction.Max(Excel.WorksheetFunction.Min(blue_rgb, 255), 0) * 16 * 16 * 16 * 16
swAppearanceSetting.Color = newColor
Set newAppearances(0) = swAppearanceSetting
swModelDocExt.DisplayStateSpecMaterialPropertyValues(swDisplayStateSetting) = newAppearances
swRenderMaterial.BumpTextureFilename = "color"
Set swModel = swApp.ActiveDoc
swModel.ShowNamedView2 "*Isometric", 7
swModel.ViewZoomtofit2
FilePath = swModel.GetPathName
swModel.SaveAs FilePath
swApp.CloseDoc swModel.GetTitle
End Sub
Please help.
thank you, I've decided to give up on the macro. Time investing is not worth it after all.
Instead I've made a new appearance.
Thank you for your help Leon.