AnsweredAssumed Answered

Help with appearance Macro

Question asked by Evan Lockard on Jun 29, 2020

Morning all,

 

I found a pretty simple macro online that applies an appearance to parts, in my case, Pine.  Currently, I go in and change the orientation of the grain to go along the longest dimension (think a 2x4x8', grain along the length, as it would appear in reality).  I'm wondering if there is a way to include this function in the macro?  Check for the longest dimension, and orient the appearance to match?  Any help is greatly appreciated,  the macro is below.

 

Option Explicit
      
Const APPEARANCE_PATH As String = _
    "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\data\graphics\Materials\organic\wood\pine\satin finished pine 2d.p2m"
      
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swObj As Object
    Dim swRenderMat As SldWorks.RenderMaterial
      
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swObj = swSelMgr.GetSelectedObject6(1, -1)
      
    If swModel.GetType = swDocPART Then
      
        If swObj Is Nothing Then Set swObj = swModel
          
    ElseIf swModel.GetType = swDocASSEMBLY Then
      
        Dim swAssy As SldWorks.AssemblyDoc
        Dim swComp As SldWorks.Component2
        Dim lngInfo As Long
          
        Set swAssy = swModel
          
        If TypeOf swObj Is SldWorks.Face2 Or _
            TypeOf swObj Is SldWorks.Feature Or _
            TypeOf swObj Is SldWorks.Body2 Then
              
            Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
            swComp.Select4 False, Nothing, False
            swAssy.EditPart2 False, True, lngInfo
              
            If lngInfo = -1 Then
                swApp.SendMsgToUser "Failed to edit component."
                Exit Sub
            End If
              
        End If
          
    Else
        Exit Sub
    End If
      
    Set swRenderMat = swModel.Extension.CreateRenderMaterial(APPEARANCE_PATH)
      
    If swRenderMat.AddEntity(swObj) = False Then
        swApp.SendMsgToUser "Failed to add entity."
        Exit Sub
    End If
      
    If swModel.Extension.AddDisplayStateSpecificRenderMaterial( _
        swRenderMat, swAllDisplayState, Empty, Empty, Empty) = False Then
        swApp.SendMsgToUser "Failed to add appearance."
        Exit Sub
    End If
      
    swModel.EditRebuild3
              
    If Not swComp Is Nothing Then
        swComp.Select4 False, Nothing, False
        swAssy.EditAssembly
    End If
      
End Sub

Outcomes