8 Replies Latest reply on Aug 19, 2015 4:17 AM by Willie Roelofs

    VBA Appearance Editing

    Willie Roelofs
    Willie Roelofs Jul 24, 2015 5:16 AM

      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.

        • Re: VBA Appearance Editing
          Willie Roelofs
          Willie Roelofs Jul 24, 2015 5:17 AM (in response to Willie Roelofs)

          Edit:

          Currently I'm doing the following:

           

          to

          Currently I'm doing the following manually:

          • Re: VBA Appearance Editing
            Leon Wurr
            Leon Wurr Aug 17, 2015 10:34 AM (in response to Willie Roelofs)

            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
              • Re: VBA Appearance Editing
                Willie Roelofs
                Willie Roelofs Aug 18, 2015 3:19 AM (in response to Leon Wurr)

                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)

                  • Re: VBA Appearance Editing
                    Willie Roelofs
                    Willie Roelofs Aug 18, 2015 4:35 AM (in response to Willie Roelofs)

                    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.

                      • Re: VBA Appearance Editing
                        Leon Wurr
                        Leon Wurr Aug 18, 2015 8:00 AM (in response to Willie Roelofs)

                        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