Attribute VB_Name = "Module1"
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim ThisPart As New swPartClass
Dim ActiveDoc As Object
Dim ActiveDocTitle As String
Dim TargetModel As Object
Dim TargetVisibility As Boolean
Dim TargetPath As String
Dim TargetTitle As String
Dim bContextFlag As Boolean
Dim swBody As SldWorks.body2
Dim swBodies As Variant 'for return from PartDoc::GetBodies2
Dim swFace As SldWorks.face2
'Dim swEntity As SldWorks.entity
Dim SelMgr As SldWorks.SelectionMgr
'color table stuff
Dim swColorTable As SldWorks.ColorTable
Dim swBasicColorCount As Long
Dim swColor As Long
Dim swBasicColors As Variant

Dim bName As String
Dim B1p As Variant
Dim pProps As Variant 'material property values of part
    '[ R, G, B, Ambient, Diffuse, Specular, Shininess, Transparency, Emission ]
Dim I As Long
Dim retBool As Boolean
Dim retLong As Long
Dim retVar As Variant
Dim retObj As Object
Dim retString As String

Public Sub ScrubFacesClean()
SetupSwStuff
TargetActivate
ThisPart.Model.SetSaveFlag

swBodies = ThisPart.Part.GetBodies2(swAllBodies, False)
If IsEmpty(swBodies) Then
    MsgBox "No bodies found"
    Exit Sub
End If

pProps = ThisPart.Part.MaterialPropertyValues
'[ R, G, B, Ambient, Diffuse, Specular, Shininess, Transparency, Emission ]

For I = LBound(swBodies) To UBound(swBodies)
    Set swBody = swBodies(I)
    Set swFace = swBody.GetFirstFace
    Do While Not swFace Is Nothing
        retBool = swFace.Select3(False, 0, retObj)
        retBool = ThisPart.Model.SelectedFaceProperties(0, CDbl(pProps(3)), CDbl(pProps(4)), _
            CDbl(pProps(5)), CDbl(pProps(6)), CDbl(pProps(7)), CDbl(pProps(8)), _
            True, vbNullString)
        Set swFace = swFace.GetNextFace
    Loop
Next

SelMgr.DeSelect 1
swApp.ActivateDoc2 ActiveDocTitle, True, 0
ThisPart.Model.Visible = TargetVisibility
End Sub
Public Sub TammyFaye()
SetupSwStuff
TargetActivate
Dim RandomColor As Long

Randomize
Set swColorTable = ThisPart.Model.GetColorTable
swBasicColorCount = swColorTable.GetBasicColorCount
swBasicColors = swColorTable.GetBasicColors

ThisPart.Model.SetSaveFlag

swBodies = ThisPart.Part.GetBodies2(swAllBodies, False)
If IsEmpty(swBodies) Then
    MsgBox "No bodies found"
    Exit Sub
End If

pProps = ThisPart.Model.MaterialPropertyValues
'[ R, G, B, Ambient, Diffuse, Specular, Shininess, Transparency, Emission ]

For I = LBound(swBodies) To UBound(swBodies)
    Set swBody = swBodies(I)
    Set swFace = swBody.GetFirstFace
    Do While Not swFace Is Nothing
        RandomColor = swBasicColors(Int(swBasicColorCount * Rnd))
        retBool = swFace.Select3(False, 0, retObj)
        retBool = ThisPart.Model.SelectedFaceProperties(RandomColor, CDbl(pProps(3)), CDbl(pProps(4)), _
            CDbl(pProps(5)), CDbl(pProps(6)), CDbl(pProps(7)), CDbl(pProps(8)), _
            False, vbNullString)
        Set swFace = swFace.GetNextFace
    Loop
Next

SelMgr.DeSelect 1
swApp.ActivateDoc2 ActiveDocTitle, True, 0
ThisPart.Model.Visible = TargetVisibility
End Sub
Private Sub TargetActivate()
Dim lRetErrors As Long
Dim lRetWarnings As Long

If Not bContextFlag Then Exit Sub
ActiveDocTitle = ActiveDoc.GetTitle
TargetVisibility = ThisPart.Model.Visible
TargetPath = ThisPart.Model.GetPathName
TargetTitle = ThisPart.Model.GetTitle
swApp.ActivateDoc2 TargetTitle, True, 0
'swApp.OpenDoc6 TargetPath, 1, swOpenDocOptions_Silent, "", lRetErrors, lRetWarnings

End Sub
Private Function SetupSwStuff() As Boolean
Dim bIsPart As Boolean
Dim lPartType As Long

bIsPart = False
SetupSwStuff = False

'set up connection to SW
Set swApp = CreateObject("sldworks.application")
If swApp Is Nothing Then
    MsgBox "SolidWorks application not found."
    Exit Function
End If

Set ActiveDoc = swApp.ActiveDoc
If ActiveDoc Is Nothing Then
    MsgBox "No active document found."
    Exit Function
End If

'test edit target to make sure it is a part
retLong = ActiveDoc.GetType
If retLong = 1 Then
    Set TargetModel = ActiveDoc
    TargetVisibility = True
    bIsPart = True
ElseIf retLong = 2 Then 'ASSEMBLY: check if edit target is part
    Set TargetModel = ActiveDoc.GetEditTarget
    lPartType = TargetModel.GetType
    If lPartType = 1 Then
        bIsPart = True
        bContextFlag = True
    End If
Else
    bIsPart = False
End If

'exit if target is not SW part
If Not bIsPart Then
    MsgBox "Active document is not a SW part."
    Exit Function
End If
    
'create swPartClass for use w/ early binding
Set ThisPart.Model = TargetModel
Set ThisPart.Extension = ThisPart.Model.Extension
Set ThisPart.Part = TargetModel

Set SelMgr = ActiveDoc.SelectionManager
'========================================
SetupSwStuff = bIsPart
End Function

