Another approach is to use HighlightSets. This solution only temporarily change color in active view and doesn't modify part document
Sub main
HighlightFaceByFeature()
End Sub
Private Sub HighlightFaceByFeature()
Dim part As PartDocument = ThisDoc.Document
Dim partDef As PartComponentDefinition = part.ComponentDefinition
Dim extrudeFaces As HighlightSet = part.CreateHighlightSet()
Dim revolveFaces As HighlightSet = part.CreateHighlightSet()
Dim holeFaces As HighlightSet = part.CreateHighlightSet()
Dim filletFaces As HighlightSet = part.CreateHighlightSet()
Dim chamferFaces As HighlightSet = part.CreateHighlightSet()
extrudeFaces.Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
revolveFaces.Color = ThisApplication.TransientObjects.CreateColor(0, 255, 0)
holeFaces.Color = ThisApplication.TransientObjects.CreateColor(0, 0, 255)
filletFaces.Color = ThisApplication.TransientObjects.CreateColor(255, 255, 0)
chamferFaces.Color = ThisApplication.TransientObjects.CreateColor(0, 255, 255)
For Each SurfaceBody As SurfaceBody In partDef.SurfaceBodies
For Each Face As Face In SurfaceBody.Faces
Select Case Face.CreatedByFeature.Type
Case ObjectTypeEnum.kExtrudeFeatureObject
extrudeFaces.AddItem(Face)
Case ObjectTypeEnum.kRevolveFeatureObject
revolveFaces.AddItem(Face)
Case ObjectTypeEnum.kHoleFeatureObject
holeFaces.AddItem(Face)
Case ObjectTypeEnum.kFilletFeatureObject
filletFaces.AddItem(Face)
Case ObjectTypeEnum.kChamferFeatureObject
chamferFaces.AddItem(Face)
'Etc.
Case Else
Continue For
End Select
Next
Next
End Sub
To clear preview you can use this code
Dim part As PartDocument = ThisDoc.Document
For Each hs As HighlightSet In part.Highlightsets
hs.Delete()
Next
part.Update