簡體   English   中英

僅在選定組件中應用 MACRO (swModel.GetComponents)

[英]Apply MACRO only in selected components (swModel.GetComponents)

我有這個代碼可以自動 colors 所有裝配組件隨機顏色。 我以前用這個代碼問過一個不同的問題,但這次,我想問是否有人可以幫助制作這個代碼 colors 只選擇了裝配組件? 我希望有人可以幫助我,我還在 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

在你設置 object 的地方,試試這個:

Set swElement = Selection

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM