Hello,
Below is the Colorize macro that has been floating around, which allows you to change the color of all the components of an assembly from the assembly itself. I modified it to try to make the colors more distinct. However, I cannot figure out how to change the wireframe color also from inside the assembly- anyone know? I want the new colors to also show up when the assembly is in wireframe.
-Mike
' ****************************************************************************** ' Traverses one level deep into assembly and turns parts random colors. ' Kevin Silbert; TriMech Solutions, LLC 'Dim PartColors(0 To 1000, 0 To 3) As Single Dim AllowedColorCloseness As Single
Dim Test2 As RGB_Type Dim Margin As Double Dim Result As Long Dim AssyName As String
Public Type RGB_Type R As Double G As Double B As Double End Type
Const swDocASSEMBLY = 2 Const swColorsGradientPartBackground = 68 Const swSystemColorsViewportBackground = 99 Const swSystemColorsTopGradientColor = 100 Const swSystemColorsBottomGradientColor = 101 Const swSystemColorsDynamicHighlight = 102 Const swSystemColorsHighlight = 103 Const swSystemColorsSelectedItem1 = 104 Const swSystemColorsSelectedItem2 = 105 Const swSystemColorsSelectedItem3 = 106 Const swSystemColorsSelectedFaceShaded = 107 Const swSystemColorsDrawingsVisibleModelEdge = 108 Const swSystemColorsDrawingsHiddenModelEdge = 109 Const swSystemColorsDrawingsPaperBorder = 110 Const swSystemColorsDrawingsPaperShadow = 111 Const swSystemColorsImportedDrivingAnnotation = 112 Const swSystemColorsImportedDrivenAnnotation = 113 Const swSystemColorsSketchOverDefined = 114 Const swSystemColorsSketchFullyDefined = 115 Const swSystemColorsSketchUnderDefined = 116 Const swSystemColorsSketchInvalidGeometry = 117 Const swSystemColorsSketchNotSolved = 118 Const swSystemColorsGridLinesMinor = 119 Const swSystemColorsGridLinesMajor = 120 Const swSystemColorsConstructionGeometry = 121 Const swSystemColorsDanglingDimension = 122 Const swSystemColorsText = 123 Const swSystemColorsAssemblyEditPart = 124 Const swSystemColorsAssemblyEditPartHiddenLines = 125 Const swSystemColorsAssemblyNonEditPart = 126 Const swSystemColorsInactiveEntity = 127 Const swSystemColorsTemporaryGraphics = 128 Const swSystemColorsTemporaryGraphicsShaded = 129 Const swSystemColorsActiveSelectionListBox = 130 Const swSystemColorsSurfacesOpenEdge = 131 Const swSystemColorsTreeViewBackground = 132
Function GetRandom() As Variant Dim Rand(8) As Variant Dim Temp As Variant Valid = True Randomize Rand(0) = Rnd * 0.6 + 0.4 'Red Rand(1) = Rnd * 0.6 + 0.4 'Green Rand(2) = Rnd * 0.6 + 0.4 'Blue Rand(3) = 1 Rand(4) = 1 Rand(5) = 1 Rand(6) = 1 'Rand(3) = Rnd / 2 + 0.5 'Ambient 'Rand(4) = Rnd / 2 + 0.5 'Diffuse 'Rand(5) = Rnd 'Specular 'Rand(6) = Rnd * 0.9 + 0.1 'Shininess 'Temp = CheckRange(Rand, ViewportBackground, Margin) 'Temp = CheckRange(Rand, TopGradientColor, Margin / 3) ' Less sensitive 'Temp = CheckRange(Rand, BottomGradientColor, Margin / 3) ' Less Sensitive 'Temp = CheckRange(Rand, SelectedItem1, Margin) 'Temp = CheckRange(Rand, SelectedFaceShaded, Margin) 'Temp = CheckRange(Rand, SketchFullyDefined, Margin * 1.15) 'More Sensitive 'Temp = CheckRange(Rand, SketchUnderDefined, Margin * 1.15) 'More Sensitive GetRandom = Rand End Function
Public Function ToRGB(ByVal Color As Long) As RGB_Type ' Returns NORMALIZED (0-1 instead of 0-255) Red/Green/Blue values Dim ColorStr As String ColorStr = Right$("000000" & Hex$(Color), 6) With ToRGB .R = Val("&h" & Right$(ColorStr, 2)) / 255 .G = Val("&h" & Mid$(ColorStr, 3, 2)) / 255 .B = Val("&h" & Left$(ColorStr, 2)) / 255 End With End Function
Public Function CheckRange(ByVal Num1 As Variant, ByRef TempRGB As RGB_Type, Margin As Double) Dim Dist As Double Dist = ((TempRGB.R - Num1(0)) ^ 2 + (TempRGB.G - Num1(1)) ^ 2 + (TempRGB.B - Num1(2)) ^ 2) ^ 0.5 If Dist < Margin Then Valid = False End Function
Sub main()
On Error Resume Next Set swApp = CreateObject("SldWorks.Application") Set AssyDoc = swApp.ActiveDoc ' Current document If (AssyDoc.GetType swDocASSEMBLY) Then Exit Sub ' Make sure this is an assembly
AssyName = AssyDoc.GetTitle 'Current Assy Name If InStr(1, AssyName, ".") Then AssyName = Left$(AssyName, InStr(1, AssyName, ".") - 1) 'Strip off .SLDASM if its there End If
'originally .75 Margin = 2 'Margin describes how close the new color is allowed to be to existing system colors. 'Lower values are more "picky"- fewer colors will be available, but they will not 'be near system colors at all.
'Get user prefs so we can avoid the nearby colors ViewportBackground = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsViewportBackground)) TopGradientColor = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsTopGradientColor)) BottomGradientColor = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsBottomGradientColor)) SelectedItem1 = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsSelectedItem1)) SelectedFaceShaded = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsSelectedFaceShaded)) SketchFullyDefined = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsSketchFullyDefined)) SketchUnderDefined = ToRGB(swApp.GetUserPreferenceIntegerValue(swSystemColorsSketchUnderDefined))
'If not using gradient, then set these values to be identical to background color to prevent unnecessary avoiding of colors If swApp.GetUserPreferenceToggle(swColorsGradientPartBackground) = False Then TopGradientColor = ViewportBackground If swApp.GetUserPreferenceToggle(swColorsGradientPartBackground) = False Then BottomGradientColor = ViewportBackground
' Find the Root Component Set Configuration = AssyDoc.GetActiveConfiguration() Set RootComponent = Configuration.GetRootComponent() Component = RootComponent.GetChildren
k = 0 ChildCount = UBound(Component) + 1 For i = 0 To (ChildCount - 1) ' For each Child in this subassembly Set Child = Component(i) ' Get Child component object
'Randomize the color of selected part Valid = False
While Not Valid = True k = k + 1 Temp = GetRandom() 'MsgBox ("RGB=" & Temp(0) & ", " & Temp(1) & ", " & Temp(2))
AllowedColorCloseness = 0.1 If i > 0 Then 'MsgBox ("RGB=" & Temp(0) & ", " & Temp(1) & ", " & Temp(2))
For j = 0 To i If (Abs(Temp(0) - PartColors(j, 0)) < AllowedColorCloseness) And (Abs(Temp(1) - PartColors(j, 1)) < AllowedColorCloseness) And (Abs(Temp(2) - PartColors(j, 2)) < AllowedColorCloseness) Then Valid = False 'MsgBox ("Rejected") 'need a break Exit For Else Valid = True End If Next j Else 'keep first color at an extreme to avoid making it to easy to match (since every color is checked against it) 'If (Abs(Temp(0) - 0.5) < 0.5 * AllowedColorCloseness) And (Abs(Temp(1) - 0.5) < 0.5 * AllowedColorCloseness) And (Abs(Temp(2) -
0.5) < 0.5 * AllowedColorCloseness) Then ' Valid = False 'MsgBox ("Rejected first color") 'Else ' Valid = True 'End If End If 'Break if too many rejections, otherwise Solidworks hangs If k = 100000 Then MsgBox ("Too many interations, quiting") End End If WendPartColors(i, 0) = Temp(0) PartColors(i, 1) = Temp(1) PartColors(i, 2) = Temp(2)
'MsgBox ("RGB=" & PartColors(Temp(0) & ", " & Temp(1) & ", " & Temp(2))
Set ModelDoc = Child.GetModelDoc
Ret = ModelDoc.MaterialPropertyValues Ret(0) = Temp(0) Ret(1) = Temp(1) Ret(2) = Temp(2) Ret(3) = Temp(3) Ret(4) = Temp(4) Ret(5) = Temp(5) Ret(6) = Temp(6) ModelDoc.MaterialPropertyValues = Ret ' AssyDoc.EditAssembly Next i AssyDoc.EditRebuild Set swApp = Nothing End Sub