# Autocad VBA Color Wheel Program Part 2 The color wheel main program has a loop that is controlled by the number of colors or number of segments to be drawn. The key question now is really the point of the whole program, what is the scheme for mixing colors? Our first test subroutine uses a random number generator. This shows the loop in simple form. Each time through the loop a random number between 0 and 255 is generated for each of the RGB values. The wheel can be any size, even hundreds of segments, and it can cover any angle of revolution. This is not the standard color wheel which has definite rules for placing colors.

```Sub testwheel1()
Call connect_acad
Dim i As Integer
Dim numcolors As Integer
Dim angl_rev As Double
Dim r1 As Double, r2 As Double
Dim a1 As Double, a2 As Double, a_inc As Double
Dim i_r As Integer, i_g As Integer, i_b As Integer

'parameters to be input from a user form
numcolors = 18
angl_rev = 360
a1 = 0 'start angle
r1 = 6 'interior radius
r2 = 12 'outside radius

a_inc = angl_rev / numcolors
a2 = a1 + a_inc

For i = 1 To numcolors
'random number generators for RGB values
i_r = Int((255 - 0 + 1) * Rnd + 0)
i_g = Int((255 - 0 + 1) * Rnd + 0)
i_b = Int((255 - 0 + 1) * Rnd + 0)

THIS IS ANNOYING AS CRAP WHAT THE WORDPRESS EDITOR DOES TO QUOTED STRINGS
IN THE CODE

Debug.Print i & ", " & i_r & ", " & i_g & ", " & i_b

Call makeslice(r1, r2, a1, a2, i_r, i_g, i_b)
a1 = a1 + a_inc
a2 = a1 + a_inc

Next i
Update
End Sub
```

some of these were not random but made trying various incrementing strategies. the colors in these are all generated with the vba random number function. The standard color wheel has a definite pattern. The 3 primary colors are evenly spaced around the wheel at 120 degrees. Midway between them is a pure blend where each of the primary colors is mixed full strength. The most common wheel has 12 colors, but any number can be used, the wheel keeps the same colors in the same locations, there are just more transition colors between them. No matter how many colors are used, an array can be used to hold the RGB values. There is an array for each of the RGB components. They have the same data in the same order, but each array is shifted one third the length of the array from the previous array. The data “shift” is the number of colors divided by 3.

here is the final test version of the standard color wheel

```Sub test_stdwheel_1()
Call connect_acad
Dim i As Integer
Dim numcolors As Integer
Dim angl_rev As Double
Dim r1 As Double, r2 As Double
Dim a1 As Double, a2 As Double, a_inc As Double
Dim i_r As Integer, i_g As Integer, i_b As Integer
Dim shift As Integer

'parameters to be input from a user form
numcolors = 512
angl_rev = 360
a1 = 0 'start angle
r1 = 0.1 'interior radius
r2 = 14 'outside radius

a_inc = angl_rev / numcolors
a2 = a1 + a_inc
shift = numcolors / 3

'preparation of the RGB value arrays
Dim data_array() As Integer
Dim red_array() As Integer
Dim green_array() As Integer
Dim blue_array() As Integer

ReDim red_array(1 To numcolors)
ReDim green_array(1 To numcolors)
ReDim blue_array(1 To numcolors)
'data_array is the generic pattern created for a specific numcolor
Call make_data_array(data_array, numcolors)

'red and data_array are the same
For i = 1 To numcolors
red_array(i) = data_array(i)
Next i

Call copyshiftarray(red_array, green_array, shift)
Call copyshiftarray(green_array, blue_array, shift)

For i = 1 To numcolors
Call makeslice(r1, r2, a1, a2, red_array(i), green_array(i), blue_array(i))
a1 = a1 + a_inc
a2 = a1 + a_inc
Next i

Update
End Sub
```

Make_data_array takes the empty array as an argument, and the number of colors, divides up the array into 4 sections, and fills the data. It uses a subroutine retndx to figure the exact values for the ascending and descending sections.

```Sub make_data_array(ByRef data_array() As Integer, clrs As Integer)
Dim i As Integer, ndx As Integer, n As Integer
Dim A As Integer, B As Integer
Dim c As Integer, d As Integer
Dim e As Integer, f As Integer
Dim g As Integer, h As Integer

n = clrs / 6
ReDim data_array(1 To clrs)

A = 1
B = clrs / 3 + 1
c = B + 1
d = c + clrs / 6 - 2
e = d + 1
f = e + clrs / 3
g = f + 1
h = clrs

For i = A To B
data_array(i) = 255
Debug.Print 255
Next

For i = c To d
'ndx = retndx_desc(0, 255, n, i - c + 1)
ndx = retndx(255, 0, n, i - c + 1)
data_array(i) = ndx
Debug.Print ndx
Next

For i = e To f
data_array(i) = 0
Debug.Print 0
Next

For i = g To h
ndx = retndx(0, 255, n, i - g + 1)
data_array(i) = ndx
Debug.Print ndx
Next
End Sub
```
```Function retndx(A As Integer, B As Integer, n As Integer, ndx As Integer) As Integer
'n is number of spaces to divide the span AB
'ndx is the index of the value to be returned
Dim dbl_n As Double
dbl_n = (B - A) / n
retndx = A + (ndx * dbl_n)
End Function
```

Copyshiftarray takes one array as template and one array as product to be a copy but have the data shifted one third of the way around the wheel. It was made with a small sample on graph paper simply numbering boxes, for instance if the data in the first array is 1,2,3,4,5,6,7,8,9,10,11,12 and the shift is 4, the data in the second array is 5,6,7,8,9,10,11,12,1,2,3,4. The shift is calculated from numcolors/3.

```
Sub copyshiftarray(ByRef array1() As Integer, ByRef array2() As Integer, shift As Integer)
'not a general sub but one specific to application
'use with array sizes evenly divisible by 3
'use with one based index

Dim i As Integer, j As Integer
Dim index As Integer
Dim arraysize As Integer
arraysize = UBound(array1)

For i = 1 To arraysize
If i + shift &amp;amp;amp;lt;= arraysize Then
array2(i) = array1(i + shift)
Else
index = i + shift - arraysize
array2(i) = array1(index)
End If
Next i

End Sub
```

this wheel was made with 512 colors and an interior radius of 0.1 Advertisements

This site uses Akismet to reduce spam. Learn how your comment data is processed.