Apply and Remove Texture By Display State Example (VBA)

This example shows how to apply and remove texture to and from a face by display state.

'---------------------------------------------------------------------------
' Preconditions: Verify that the specified part and texture exist.
'
' Postconditions:
' 1. Opens the specified part and applies texture to the selected face.
' 2. Examine the part.
' 3. In the IDE, click the Continue button at Stop to resume execution 
'    of the macro.
' 4. Removes the texture from the face.
' 5. Examine the part to verify that the texture was removed.
'----------------------------------------------------------------------------
Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swSelMgr As SldWorks.SelectionMgr

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim face As SldWorks.Face2

Dim texture As SldWorks.texture

Dim modelview As SldWorks.modelview

Dim status As Boolean

Dim displayState As String

Dim errors As Long

Dim warnings As Long

Dim namStr As String

Dim atIndex(1) As Long

Sub main()

' Open document and select a face

Set swApp = Application.SldWorks

Set swModel = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\api\pplate.sldprt", swDocPART, swOpenDocOptions_Silent, "", errors, warnings)

Set swModelDocExt = swModel.Extension

status = swModelDocExt.SelectByID2("", "FACE", -0.02341747645642, 0.03900188771217, -0.008053400767039, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager

Set face = swSelMgr.GetSelectedObject6(1, -1)

 

' Set texture on selected face in the

' specified display state

displayState = "<Default>_Display State 1"

namStr = "<SystemTexture>\images\textures\pattern\checker2.jpg"

Set texture = swModelDocExt.CreateTexture(namStr, 5, 45, False)

status = face.SetTextureByDisplayState(displayState, texture)

 

' Redraw the window view

Set modelview = swModel.ActiveView

modelview.GraphicsRedraw (Empty)

 

' Examine the selected face to verify

' that the specified texture was set

' In the IDE, click the Continue button to resume

' running macro

Stop

 

' Remove texture from face by display state

status = swModelDocExt.SelectByID2("", "FACE", -0.02341747645642, 0.03900188771217, -0.008053400767039, False, 0, Nothing, 0)

Set face = swSelMgr.GetSelectedObject6(1, -1)

status = face.RemoveTextureByDisplayState(displayState)

 

' Deselect the face to verify

' that the texture was removed

atIndex(1) = 1

status = swSelMgr.DeSelect2(atIndex, -1)

End Sub