API help for changing wireframe color

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
' www.trimechtech.com
'
******************************************************************************
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, j, k, 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 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
Wend

PartColors(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

 

The setting you are talking about is a part document property (Tools>
Options>Doc Props>Color>Apply same color to Wireframe, HLR and Shaded.

I have a VB6 project that goes through a directory and changes the setting
in all the SW parts. I used it to change the setting on a bunch of parts I
had at one point. Anyway, you can get it from my website
http://mysite.verizon.net/mjlombard/ and follow the link for the macro
library.

Matt

 

hello,

instead of setting shading to 'red' and setting 'use same color for
wireframe as shaded', is it possible to simply set the shading color =
red and the wireframe color = red at the same time?

-Mike

 

Only if you already have the switch turned on at Tools>Options>Doc Props>
Colors>Apply Same Color to Shaded, Wireframe and HLR. The default
templates don't have this switch turned on, and since it's a document
property, you have to turn it on in each part where you want the wireframe
and shaded colors to be the same. That's why I wrote the macro, to set the
setting correctly for a large number of files so that when the shaded color
changes, the wireframe color follows it.

matt