Make Part Transparent Example (VBA)
This example shows how to make a part transparent.
'----------------------------------------------------
'
' Preconditions: Part is open.
'
' Postconditions: Part is now transparent.
'
'-----------------------------------------------------
Option Explicit
Public Enum swUserPreferenceIntegerValue_e
swDocumentColorShading
= 185
End Enum
Public Enum swBodyType_e
swAllBodies
= -1
swSolidBody
= 0
swSheetBody
= 1
swWireBody
= 2
swMinimumBody
= 3
swGeneralBody
= 4
swEmptyBody
= 5
End Enum
Function GetRValue(MyColour As Long) As Long
GetRValue
= MyColour Mod 256
End Function
Function GetGValue(MyColour As Long) As Long
GetGValue
= (MyColour \ 256) Mod 256
End Function
Function GetBValue(MyColour As Long) As Long
GetBValue
= (MyColour \ 65536) Mod 256
End Function
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swPart As
SldWorks.PartDoc
Dim
nDefaultColour As
Long
Dim
vBodyArr As
Variant
Dim
vBody As
Variant
Dim
swBody As
SldWorks.body2
Dim
swFace As
SldWorks.face2
Dim
nMatProp(9) As
Double
Dim
vMatProp As
Variant
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swPart = swModel
nDefaultColour
= swModel.GetUserPreferenceIntegerValue(swDocumentColorShading)
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" Default
Colour = RGB(" & GetRValue(nDefaultColour) & ", "
& GetGValue(nDefaultColour) & ", " & GetBValue(nDefaultColour)
& ")"
'
Set to sensible defaults
'
Grey for default colour
nMatProp(0)
= GetRValue(nDefaultColour) / 255# '
red
nMatProp(1)
= GetRValue(nDefaultColour) / 255# '
green
nMatProp(2)
= GetRValue(nDefaultColour) / 255# '
blue
nMatProp(3)
= 1# '
Ambient
nMatProp(4)
= 1# '
Diffuse
nMatProp(5)
= 1# '
Specular
nMatProp(6)
= 0.31 '
Shininess
'
Increase transparency
nMatProp(7)
= 0.95 '
Transparency
nMatProp(8)
= 0# '
Emmission
vMatProp
= nMatProp
vBodyArr
= swPart.GetBodies2(swAllBodies,
True)
For
Each vBody In vBodyArr
Set
swBody = vBody
Set
swFace = swBody.GetFirstFace
While
Not swFace Is Nothing
swFace.MaterialPropertyValues = vMatProp
Set
swFace = swFace.GetNextFace
Wend
Next
'
Redraw to see new transparency
swModel.GraphicsRedraw2
End Sub
'----------------------------------------------------