AnsweredAssumed Answered

VBA Appearance Editing

Question asked by Willie Roelofs on Jul 24, 2015
Latest reply on Aug 19, 2015 by Willie Roelofs

Like • Show 0 Likes0
Comment • 8

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.

Willie Roelofs Aug 19, 2015 4:17 AM

Correct Answer

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.

See the reply in context

1 person had this question

Outcomes

Willie Roelofs Jul 24, 2015 5:17 AM

Edit:

Currently I'm doing the following:

Currently I'm doing the following manually:

Actions

Leon Wurr @ Willie Roelofs on Jul 24, 2015 9:24 AM

Try this to set the appearance as "Dark Powder Coat":

2010 SOLIDWORKS API Help - Apply Appearance to Model Example (VBA)

Actions

Leon Wurr Aug 17, 2015 10:34 AM

Did you figured it out?

I was trying to set the width and height of the Mapping of some parts I have, but without luck.

Here's a part of the code that I wrote:

Option Explicit


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssembly As SldWorks.AssemblyDoc
Dim swComponent As SldWorks.Component2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelectionMgr As SldWorks.SelectionMgr
Dim swConfiguration As SldWorks.Configuration
Dim swRenderMaterial As SldWorks.RenderMaterial


Dim nbrRenderMaterials As Long
Dim varRendermaterials As Variant
Dim DisplayStateNames() As String
Dim i As Integer
Dim j As Integer
 
Sub main()


    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swConfiguration = swModel.GetActiveConfiguration
    nbrRenderMaterials = swModelDocExt.GetRenderMaterialsCount2(swDisplayStateOpts_e.swAllDisplayState, DisplayStateNames)
    varRendermaterials = swModelDocExt.GetRenderMaterials2(swThisDisplayState, Nothing)
    If nbrRenderMaterials > 0 Then
        For j = 0 To nbrRenderMaterials - 1
        
            Set swRenderMaterial = varRendermaterials(j)
            
            swRenderMaterial.FixedAspectRatio = False
            Debug.Print swRenderMaterial.FixedAspectRatio
            
            swRenderMaterial.Height = 0.5
            Debug.Print swRenderMaterial.Height
            
            swRenderMaterial.Width = 0.75
            Debug.Print swRenderMaterial.Width
            
        Next j
    End If
   
End Sub

Actions

Willie Roelofs @ Leon Wurr on Aug 18, 2015 3:19 AM

I haven't yet, probably by the end of the week.

Try:

swAppearance.Width = 0.5

swAppearance.Height = 0.75

2010 SOLIDWORKS API Help - Add Default Appearance Example (VBA)

Actions

Willie Roelofs @ Willie Roelofs on Aug 18, 2015 4:35 AM

Just tried the expample (copy paste): 2010 SOLIDWORKS API Help - Add Default Appearance Example (VBA)

But I get the error:

Argument not optional

In the line:

Set swAppearance = swModelDocExt.CreateRenderMaterial

Where the following is selected:

CreateRenderMaterial

Model Document is open.

Realview Graphics are enabled.

Actions

Leon Wurr @ Willie Roelofs on Aug 18, 2015 8:00 AM

That example had some errors, try this:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swAppearance As SldWorks.RenderMaterial
Dim boolstatus As Boolean
Dim strName As String
Dim nDecalID As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swModelDocExt = swModel.Extension

swModel.ClearSelection2 True

' Get the appearance to add to the model
strName = "C:\Program Files\SolidWorks Corp\SOLIDWORKS\data\graphics\Materials\metal\aluminum\aluminum treadplate.p2m"
Set swAppearance = swModelDocExt.CreateRenderMaterial(strName)
boolstatus = swAppearance.AddEntity(swModel)
swAppearance.FileName = strName
'strName = "C:\Program Files\solidworks\solidworks\data\graphics\Images\preview\legacy\brushed aluminum.bmp"
swAppearance.TextureFilename = strName
swAppearance.MappingType = 0
swAppearance.Width = 0.1
swAppearance.Height = 0.1
swAppearance.FixedAspectRatio = False
swAppearance.FitHeight = True
swAppearance.FitWidth = True
swAppearance.ColorForm = 0
' Apply the appearance to the model
boolstatus = swModelDocExt.AddDefaultRenderMaterial(swAppearance, nDecalID)

' Rebuild the model to see the newly applied appearance
Call swModel.Rebuild(swRebuildAll)

End Sub

Actions

Leon Wurr @ Leon Wurr on Aug 18, 2015 12:13 PM

I've made this attached macro.

It will get all of the IRenderMaterial interface properties.

I used it to get the properties of a part that was already with the specific appearance that I needed, so I could set the appearcance exactly the same on another part.

Hope this helps.