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
        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
    If Not swComp Is Nothing Then
        swComp.Select4 False, Nothing, False
    End If
End Sub