vba - 将 Solidworks 宏应用到选定的实体，而不是零件

Question

我有一个现有的宏，用于为装配体上的选定零件着色。但是这样做的限制是，当您在零件下选择一个实体时，它会将其视为一个实体并赋予它相同的颜色。

请看下图：

我想将此宏更改为仅对选定主体着色的内容。希望得到您的帮助。以下是代码：

Option Explicit

Public Sub ColorMacro1()
 Dim swApp As SldWorks.SldWorks
 Dim swModel As SldWorks.ModelDoc2
 Dim vMatProp As Variant
 Dim swSelMgr As SldWorks.SelectionMgr
 Dim swComp As SldWorks.Component2
 Dim Count As Integer
 Dim i As Integer

 Set swApp = Application.SldWorks
 Set swModel = swApp.ActiveDoc
 Set swSelMgr = swModel.SelectionManager

 Count = swSelMgr.GetSelectedObjectCount2(0)
 If Count = 0 Then MsgBox "No Components selected": Exit Sub

 vMatProp = swModel.MaterialPropertyValues
 For i = 1 To Count
 Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, 0)

Randomize
 vMatProp(0) = Rnd 'Red
 vMatProp(1) = Rnd 'Green
 vMatProp(2) = Rnd 'Blue

 vMatProp(3) = Rnd / 2 + 0.5 'Ambient
 vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
 vMatProp(5) = Rnd 'Specular
 vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
 swComp.MaterialPropertyValues = vMatProp
Next

swModel.GraphicsRedraw2
End Sub

Answer 1

只需将 Component 替换为 Body，如下所示：

Option Explicit
Public Sub ColorMacro1()
 Dim swApp As SldWorks.SldWorks
 Dim swModel As SldWorks.ModelDoc2
 Dim vMatProp As Variant
 Dim swSelMgr As SldWorks.SelectionMgr
 Dim swBody As SldWorks.Body2
 Dim Count As Integer
 Dim i As Integer

 Set swApp = Application.SldWorks
 Set swModel = swApp.ActiveDoc
 Set swSelMgr = swModel.SelectionManager

 Count = swSelMgr.GetSelectedObjectCount2(0)
 If Count = 0 Then MsgBox "No Components selected": Exit Sub

 vMatProp = swModel.MaterialPropertyValues
 For i = 1 To Count
  If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSOLIDBODIES Then
   Set swBody = swSelMgr.GetSelectedObject6(i, -1)

   Randomize
   vMatProp(0) = Rnd 'Red
   vMatProp(1) = Rnd 'Green
   vMatProp(2) = Rnd 'Blue

   vMatProp(3) = Rnd / 2 + 0.5 'Ambient
   vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
   vMatProp(5) = Rnd 'Specular
   vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
   swBody.MaterialPropertyValues2 = vMatProp
  End If
 Next

 swModel.GraphicsRedraw2
End Sub