1

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:

enter image description here

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
Mark donne
  • 17
  • 5

1 Answers1

1

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
JeromeP
  • 458
  • 3
  • 7
  • This works really great Jerome. Thank you very much for this helpful answer. I hope I can get your email and we work for lots of macro projects – Mark donne Jul 22 '21 at 14:00