0 Replies Latest reply on Nov 8, 2018 4:39 AM by Veit Wollinger

    how to add a rendermaterial to a specific display state

    Veit Wollinger

      why does this Code not work?

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


      'Written by Keith Rice
      'CADSharp LLC

      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