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