AnsweredAssumed Answered

Set appearance size/orientation in macro

Question asked by Evan Lockard on Aug 20, 2020

I found a macro online for applying appearances for parts.  It works great, but I'm wondering if there is a way to set the Size/Orientation of the appearance when I apply the appearance?  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