SolidWorks VBA宏批量修改选中面颜色的问题与解决

开发SolidWorks宏时，需要实现批量修改所有选中面颜色的功能，但官方提供的示例仅支持单个选中面修改。

最初的单面子程序 #

Sub color(R As Integer, G As Integer, B As Integer)
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swFace As SldWorks.Face2
    Dim vFaceProp As Variant
    Dim bRet As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swFace = swSelMgr.GetSelectedObject6(1, -1)
    vFaceProp = swFace.MaterialPropertyValues
    If IsEmpty(vFaceProp) Then
        ' 若未设置面级颜色，则从模型获取默认值
        vFaceProp = swModel.MaterialPropertyValues
    End If
    ' 打印当前颜色属性
    Debug.Print "RGB            = [" & vFaceProp(0) * 255# & ", " & vFaceProp(1) * 255# & ", " & vFaceProp(2) * 255# & "]"
    Debug.Print "Ambient        = " & vFaceProp(3)
    Debug.Print "Diffuse        = " & vFaceProp(4)
    Debug.Print "Specular       = " & vFaceProp(5)
    Debug.Print "Shininess      = " & vFaceProp(6)
    Debug.Print "Transparency   = " & vFaceProp(7)
    Debug.Print "Emission       = " & vFaceProp(8)
    ' 设置新颜色
    bRet = swModel.SelectedFaceProperties(RGB(R, G, B), vFaceProp(3), vFaceProp(4), vFaceProp(5), vFaceProp(6), vFaceProp(7), vFaceProp(8), False, "")
    
    ' 取消选中以查看新颜色
    swModel.ClearSelection2 True
End Sub

解决后的批量修改子程序 #

已适配SolidWorks 2015版本，实现批量修改所有选中面颜色：

Sub color(R As Integer, G As Integer, B As Integer)

    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swSelMgr                    As SldWorks.SelectionMgr
    Dim swFace                      As SldWorks.Face2
    Dim bRet                        As Boolean
    Dim PocPloch                    As Integer
    Dim i                           As Long
    Dim color As Integer

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
   
    PocPloch = swSelMgr.GetSelectedObjectCount ' 获取选中面的数量

    ' 从后往前遍历选中面，避免索引偏移问题
    For i = PocPloch To 1 Step -1
        Set swFace = swSelMgr.GetSelectedObject(i) ' 获取当前选中面
        ' 设置当前选中面的颜色
        swModel.SelectedFaceProperties GetHexFromRGB(R, G, B), 0.5, 0.5, 1, 0.315, 0, 0, 0, ""
        bRet = swFace.DeSelect ' 取消当前面的选中状态
    Next i

End Sub

配套RGB转十六进制函数 #

需要搭配以下函数实现RGB值到SolidWorks兼容十六进制颜色值的转换（注意此处需按BGR顺序转换）：

Function GetHexFromRGB(R As Integer, G As Integer, B As Integer) As String
' 注意：SolidWorks要求此处按BGR顺序而非RGB顺序转换
GetHexFromRGB = "&H" & VBA.Right$("" & VBA.Hex(B), 2) & _
    VBA.Right$("00" & VBA.Hex(G), 2) & VBA.Right$("00" & VBA.Hex(R), 2)

End Function

内容的提问来源于stack exchange，提问作者jeffp