AnsweredAssumed Answered

how to add a rendermaterial to a specific display state

Question asked by Veit Wollinger on Nov 8, 2018

why does this Code not work?

want to add a rendermaterial to a specific Display state (Display state name ="Innen")


'Written by Keith Rice

Option Explicit

Const APPEARANCE_PATH As String = _

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, swSpecifyDisplayState, "Innen", 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