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:

'    Part opened by macro exists.

'

' Postconditions:

' 1. Part opened and texture applied to selected face.

' 2. In the IDE, click the Continue button at Stop

'    to resume execution of macro.

' 3. 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:\Program Files\SolidWorks Corp\SolidWorks\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 Run > Continue 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