Option Explicit

Sub SetHoleColor(pFeat As SldWorks.Feature, r As Integer, g As Integer, b As Integer, pModel As SldWorks.ModelDoc2)

    Dim vMaterialPropVal            As Variant
    Dim bRet                        As Boolean
    
    ' フィーチャーから既存の色情報取得
    vMaterialPropVal = pFeat.GetMaterialPropertyValues2(swThisConfiguration, "")
    
    ' フィーチャー色が割り当てられていなければ、部品(または構成部品)のデフォルト色から取得
    ' (割り当てられてない場合、全ての値が-1で返ってくるので真っ黒にってしまいます)
    If vMaterialPropVal(3) < 0 Then
        ' この処理のためにTraverseFeatureFeaturesにModelDocを渡すように手を加えています。
        vMaterialPropVal = pModel.MaterialPropertyValues
    End If
    
    ' RGBだけ書き換え
    vMaterialPropVal(0) = r / 255 ' 赤
    vMaterialPropVal(1) = g / 255 ' 緑
    vMaterialPropVal(2) = b / 255 ' 青
    
    ' フィーチャーに設定
    pFeat.SetMaterialPropertyValues2 vMaterialPropVal, swThisConfiguration, ""

End Sub

Sub TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long, pModel As SldWorks.ModelDoc2)

    Dim swSubFeat                   As SldWorks.Feature
    Dim swWizHoleFeat               As SldWorks.WizardHoleFeatureData2
    Dim sPadStr                     As String
    Dim i                           As Long
    
    For i = 0 To nLevel
        sPadStr = sPadStr + "  "
    Next i
    
    ' APIヘルプではサブフィーチャーまでTraverseしてますが、穴ウィザードはサブフィーチャーに成り得ないので省きました。
    While Not swFeat Is Nothing
        Debug.Print sPadStr + swFeat.Name + " [" + swFeat.GetTypeName + "]"
        
        ' 穴ウィザード判断
        If swFeat.GetTypeName2 = "HoleWzd" Then
            Set swWizHoleFeat = swFeat.GetDefinition
            
            ' 穴種類判別(APIヘルプでWizardHoleFeatureData2::FastenerType2を参照)
            Select Case swWizHoleFeat.FastenerType2
            
            Case swStandardJISTappedHole, swStandardJISTappedHoleBottoming
                ' 緑に着色
                SetHoleColor swFeat, 0, 255, 0, pModel
            Case swStandardISODrillSizes, swStandardISOScrewClearances, swStandardISOTapDrills
                ' 青に着色
                SetHoleColor swFeat, 0, 0, 255, pModel
            Case Else
                ' 何もしない(何もしないなら Case Else 自体必要ないですが、一応…)
            End Select
        End If
        Set swFeat = swFeat.GetNextFeature
    Wend

End Sub

Sub TraverseComponentFeatures(swComp As SldWorks.Component2, nLevel As Long)

    Dim swFeat                      As SldWorks.Feature
    
    Set swFeat = swComp.FirstFeature
    TraverseFeatureFeatures swFeat, nLevel, swComp.GetModelDoc

End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

    Dim vChildComp                  As Variant
    Dim swChildComp                 As SldWorks.Component2
    Dim swCompConfig                As SldWorks.Configuration
    Dim sPadStr                     As String
    Dim i                           As Long
    
    For i = 0 To nLevel - 1
        sPadStr = sPadStr + "  "
    Next i
    
    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        
        Debug.Print sPadStr & "+" & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
        
        TraverseComponentFeatures swChildComp, nLevel
        TraverseComponent swChildComp, nLevel + 1
    Next i

End Sub

Sub TraverseModelFeatures(swModel As SldWorks.ModelDoc2, nLevel As Long)
    
    Dim swFeat                      As SldWorks.Feature
    
    Set swFeat = swModel.FirstFeature
    TraverseFeatureFeatures swFeat, nLevel, swModel
    
End Sub

Sub main()
    
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swConf                      As SldWorks.Configuration
    Dim swRootComp                  As SldWorks.Component2
    Dim nStart                      As Single
    Dim bRet                        As Boolean
    
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent
    
    nStart = Timer
    
    Debug.Print "File = " & swModel.GetPathName
    
    TraverseModelFeatures swModel, 1
    ' 部品ファイルの場合、構成部品のTraverseはしない
    If Not (swRootComp Is Nothing) Then
        TraverseComponent swRootComp, 1
    End If
    Debug.Print ""
    Debug.Print "Time = " & Timer - nStart & " s"
    
    Set swModel = Nothing
    Set swApp = Nothing

End Sub