0

我有这段代码可以自动用随机颜色为所有装配组件着色。我之前用这段代码问过一个不同的问题，但这次，我想问是否有人可以帮助使这段代码只为选定的装配组件着色？我希望有人可以帮助我，我仍在学习 API。请看下面的代码。

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Public Sub ColorMacro1()

 Dim swApp As SldWorks.SldWorks
 Dim swModel As SldWorks.ModelDoc2
 Dim swElement As Object
 Dim vElementArr As Variant
 Dim vElement As Variant
 Dim vMatProp As Variant

   Set swApp = Application.SldWorks
   Set swModel = swApp.ActiveDoc
   vMatProp = swModel.MaterialPropertyValues

'Get all elements

vElementArr = swModel.GetComponents(False)
For Each vElement In vElementArr
    Set swElement = vElement
    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
    swElement.MaterialPropertyValues = vMatProp
    Next

   'Redraw to see new color
   swModel.GraphicsRedraw2

End Sub
4

2 回答 2

0

在你设置对象的地方，试试这个：

Set swElement = Selection
于 2021-05-16T09:23:22.443 回答
0

您可以使用 GetSelectedObjectsComponent4 获取选定的组件，如下所示：

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
于 2021-05-20T06:00:27.017 回答