Hi all. I use multibody parts significantly more often than single body parts. For some reason, SW will bug out and reset all visual properties back to default. Since these multibody parts are used in drawings, the visual properties are heavily utilized to discern one component from another. As such, it's quite frustrating when SW resets these properties.
I have written a macro to iterate through the CutList folders, grab the first body's properties and write it to a cut list property. It works quite well. The plan is to periodically run this script to grab the current visual properties for all bodies. When SW resets all visual properties, a 2nd script would be run that retrieves the visual properties from the CutList and applies it to the body.
Here's my problem: while applying properties back to the body, watching the Immediate window, all values appear correct, but when 'swBody.MaterialPropertyValues2 = vMatProp' executes, the values never make it. Instead, the body turns black. Re-running 'GetColorz' and observing the new values shows completely different values.
Any assistance would be greatly appreciated.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim swFeat As SldWorks.Feature
Dim vBody As Variant
Dim vMatProp As Variant
Dim vBodyArr As Variant
Dim Str As String
Dim valOut As String
'---------------------------------------------------------
Sub GetColorz() 'this sub runs as expected
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
If Not swModel.GetType() = swDocumentTypes_e.swDocPART Then
swApp.SendMsgToUser2 "This command only works in .sldprt files.", swMbInformation, swMbOk
Exit Sub
End If
Set swFeat = swPart.FeatureByName("Solid Bodies") 'Limit to Cut List Folders
Set swFeat = swFeat.GetFirstSubFeature
While Not swFeat Is Nothing
Debug.Print "Processing: " & swFeat.Name
Dim swBodyFolder As SldWorks.BodyFolder
Set swBodyFolder = swFeat.GetSpecificFeature2
If swBodyFolder.GetBodyCount > 0 Then
bodycount = swBodyFolder.GetBodyCount
Dim vBodies As Variant
vBodies = swBodyFolder.GetBodies
Set swBody = vBodies(0)
'get Visual Material Properties
vMatProp = swBody.MaterialPropertyValues2
ConvertToString (vMatProp)
Else
Debug.Print "No Bodies Found"
End If
swFeat.CustomPropertyManager.Add3 "VisualPrps", swCustomInfoText, Str, swCustomPropertyDeleteAndAdd
Set swFeat = swFeat.GetNextSubFeature
Wend
End Sub
'---------------------------------------------------------
Function ConvertToString(vMatProp As Variant) As String
'In order to store these material properties as a custom prop, they need to be converted to a string:
'Initial Str:
Str = vMatProp(0) * 255#
vMatProp(1) = vMatProp(1) * 255#
vMatProp(2) = vMatProp(2) * 255#
'Adding all values to string:
For k = 1 To UBound(vMatProp)
Str = Str & ", " & vMatProp(k)
Next
Debug.Print "Material Property String: " & vbCr & Str & vbCr
ConvertToString = Str
End Function
'-------------------------------------------------------
Sub SetColorz() 'This sub appears to run correctly, but the values get scrambled?
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
If Not swModel.GetType() = swDocumentTypes_e.swDocPART Then
swApp.SendMsgToUser2 "This command only works in .sldprt files.", swMbInformation, swMbOk
Exit Sub
End If
Set swFeat = swPart.FeatureByName("Solid Bodies") 'Limit to Cut List Folders
Set swFeat = swFeat.GetFirstSubFeature
While Not swFeat Is Nothing
Debug.Print "Processing: " & swFeat.Name
Dim swBodyFolder As SldWorks.BodyFolder
Set swBodyFolder = swFeat.GetSpecificFeature2
If swBodyFolder.GetBodyCount > 0 Then
bodycount = swBodyFolder.GetBodyCount
Dim vBodies As Variant
vBodies = swBodyFolder.GetBodies
Set swBody = vBodies(0)
'Retrieve Visual Material Properties from CutListPrp
swFeat.CustomPropertyManager.Get2 "VisualPrps", valOut, Str
Debug.Print Str
'Convert Str to Array:
vMatProp = Split(Str, ", ")
'Unitize Color Variables:
vMatProp(0) = vMatProp(0) / 255#
vMatProp(1) = vMatProp(1) / 255#
vMatProp(2) = vMatProp(2) / 255#
Debug.Print " RGB = [" & vMatProp(0) * 255# & ", " & vMatProp(1) * 255# & ", " & vMatProp(2) * 255# & "]"
Debug.Print " Ambient = " & vMatProp(3)
Debug.Print " Diffuse = " & vMatProp(4)
Debug.Print " Specular = " & vMatProp(5)
Debug.Print " Shininess = " & vMatProp(6)
Debug.Print " Transparency = " & vMatProp(7)
Debug.Print " Emission = " & vMatProp(8)
Debug.Print ""
'All vMatProp values look good at this point, but when written using the following line, they get scrambled somehow?
swBody.MaterialPropertyValues2 = vMatProp
Else
Debug.Print "No Bodies Found"
End If
Set swFeat = swFeat.GetNextSubFeature
Wend
End Sub