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

    VBA Appearance Editing

    Willie Roelofs

      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

          Edit:

          Currently I'm doing the following:

           

          to

          Currently I'm doing the following manually:

          • Re: VBA Appearance Editing
            Leon Wurr

            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

                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

                    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

                        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