仅在选定组件中应用 MACRO (swModel.GetComponents)

Question

我有这段代码可以自动用随机颜色为所有装配组件着色。我之前用这段代码问过一个不同的问题，但这次，我想问问是否有人可以帮忙要使此代码仅对选定的装配组件着色？我希望有人能帮助我，我还在学习 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

Answer 1

设置对象的位置，试试这个：

Set swElement = Selection

Answer 2

您可以像这样使用 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

仅在选定组件中应用 MACRO (swModel.GetComponents)

Apply MACRO only in selected components (swModel.GetComponents)

vba

solidworks

solidworksapi