I have an existing macro that I use to colorize the selected part on the assembly. But the limitation for this is when you select a body under a part, it treats it as one body and giving it one same color.
Please see image below:
I want to change this macro into something that colorize selected body only. Hoping for your help. Here are the codes:
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
Just replace Component with Body, like this:
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