遍历实体每个面的颜色

design100 · 发表于 2016-4-15 08:27:37

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim retval As Variant
Dim i As Integer
Dim swFace As SldWorks.face2
Dim matProps(8) As Double
Sub main()
Set swApp = Application.SldWorks
If Not swApp Is Nothing Then
         Set swModel = swApp.ActiveDoc
      If Not swModel Is Nothing Then
         'Notice the Explicit Type Casting
         Set swPart = swModel
         If Not swPart Is Nothing Then
            retval = swPart.GetBodies2(SwConst.swSolidBody, True)
            For i = 0 To UBound(retval)
                  Set swFace = retval(i).GetFirstFace
                  matProps(0) = 1
                  matProps(1) = 0
                  matProps(2) = 0
                  matProps(3) = 1
                  matProps(4) = 1
                  matProps(5) = 0.3
                  matProps(6) = 0.3
                  matProps(7) = 0
                  matProps(8) = 0
                  Do While Not swFace Is Nothing
                     swFace.MaterialPropertyValues = ((matProps))
                     swModel.GraphicsRedraw2
                     Set swFace = swFace.GetNextFace
                  Loop
            Next i
         End If
         Set swPart = Nothing
      End If
      Set swModel = Nothing
End If
Set swApp = Nothing
End Sub