COMBINE MACRO CODES

I downloaded a macro called Colorize from here

formatting link
that is used on assemblies, and a macro called Psychedelic Colors from here
formatting link
which is used on parts. I want to make the Colorize macro use the random colors that the Psychedelic macro uses, because the Colorize macro does not have an extreme enough color scheme for me. I guess I need more contrast. I am not an experienced enough Solidworks user to pull this off. Can anyone help me? If so, I have included the code for both macros below for quick reference. Any help that you can give me would be greatly appreciated.

CODE FOR PSYCHADELIC MACRO _______________________________

Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long Dim Annotation As Object Dim Gtol As Object Dim DatumTag As Object Dim FeatureData As Object Dim Feature As Object Dim Component As Object Dim Body As Object Dim Face As Object Dim bStatus As Boolean Dim iCount As Integer Dim sFeatName As String

Sub main()

Set swApp = CreateObject("SldWorks.Application") Set Part = swApp.ActiveDoc Set Body = Part.Body Set Face = Body.GetFirstFace

While Not Face Is Nothing bStatus = Face.Select(False) Randomize Part.SelectedFaceProperties Rnd * 16581375, Rnd / 3 + 0.66, Rnd / 3

  • 0.66, Rnd, Rnd, 0, 0, 0, 0

'Part.SelectedFaceProperties 0, 0, 0, 0, 0, 0, 0, 1, "" Part.ClearSelection Set Face = Face.GetNextFace Wend DoEvents

End Sub

CODE FOR COLORIZE MACRO _______________________________

Option Explicit Dim swApp As Object Dim AssyDoc As Object Dim Configuration As Object Dim Part As Object Dim Component() As Object Dim RootComponent As Object Dim Child As Object Dim i, ChildCount As Integer Dim retval As Boolean Dim ModelDoc As Object Dim Ret As Variant Dim ViewportBackground As RGB_Type Dim TopGradientColor As RGB_Type Dim BottomGradientColor As RGB_Type Dim SelectedItem1 As RGB_Type Dim SelectedFaceShaded As RGB_Type Dim SketchFullyDefined As RGB_Type Dim SketchUnderDefined As RGB_Type Dim Valid As Boolean Dim Temp As Variant 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

Sub RandomColor() Valid = False

While Not Valid = True Temp = GetRandom() Wend

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 ModelDoc.EditRebuild

End Sub Function GetRandom() As Variant Dim Rand(8) As Variant Dim Temp As Variant Valid = True

Randomize Rand(0) = Rnd * 0.9 + 0.1 'Red Rand(1) = Rnd * 0.9 + 0.1 'Green Rand(2) = Rnd * 0.9 + 0.1 'Blue 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

Margin = 0.75 '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

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 Temp = GetRandom() Wend

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

Reply to
haleswd
Loading thread data ...

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.