COMBINE MACRO CODES

Dec 13, 2004 0 Replies

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



Join the Discussion

Have something to add? Share your thoughts — no account required.

Didn't find your answer?

Ask the community — no account required