TurboCAD (V7pro) VBA macro: Change the colour of nested objects (Groups, Symbols and Blocks) - Ty Harness 1st September 2003

Turbocad allows you to nest graphic objects via groups, symbols and blocks and you can then make groups of groups etc. Changing the colour normally has no effect on the nested graphics. Exploding the graphics will break the nesting link but this is not always desired. With a recursive function written in VBA we can change the colour of a group.

A seperate function has been used to deal with blocks. If you change the colour of one block you change the colour of all blocks with the same name even if they are sub-nested into other blocks. Blocks make good proxy graphics. Having the the colour change a certain stages of the project is very useful when several draughtsmen are working on the same general arrangement or assembaly. e.g. you can draw area boundries as blocks indicating a druaghtman is working on a certain part of the drawing indicating to other draughtmen to not change anything.

The module code below shows the recursive call that allows all the graphic levels to be accesed whether your changing the colour or any other graphic property such as layers.


Public chosencolour As Long 'use this global to store the desired colour




Sub ChangeSelectedColour()
'change only the activly selected graphics



Dim s As Selection
Set s = ActiveDrawing.Selection
'fetch the colour

UFcolorpick.Show

For i = 0 To s.Count - 1
colourgraphics s.Item(i), chosencolour
Next i

Unload UFcolorpick

s.Unselect
Set s = Nothing


End Sub


Sub ChangeAllColour()
'Change the colour of all the graphics in the drawing space

Dim g As Graphic
'fetch the colour
UFcolorpick.Show

For Each g In ActiveDrawing.Graphics
colourgraphics g, chosencolour
Next g

ActiveDrawing.ActiveView.ZoomToExtents

Unload UFcolorpick

Set g = Nothing

End Sub


Sub ChangeBlockColour()

On Error GoTo eh:

'change only the activly selected block _
if the block has been made of 2 or more blocks then it will _
not change colour, yet if you change an individual block _
colour then the nested block/or not it will change



Dim b As Block

Dim s As Selection
Set s = ActiveDrawing.Selection

'In this case I only want to deal with one selected block

If s.Count <> 1 Then Exit Sub

Set b = ActiveDrawing.Blocks(s.Item(0).Block.Name)

MsgBox s.Item(0).Block.Name
'fetch the colour

UFcolorpick.Show

For i = 0 To b.Graphics.Count - 1
colourgraphics b.Graphics.Item(i), chosencolour
Next i

Unload UFcolorpick

s.Unselect
Set s = Nothing
Set b = Nothing

Exit Sub

eh:

If Err.Number = 91 Then MsgBox "Err 91:The selected graphic is not a block" Else _
MsgBox Err.Number & "  " & Err.Description


End Sub





Function colourgraphics(g As Graphic, colour As Long) As Integer

On Error Resume Next
'should really think about where this function can break down

If g.Graphics.Count = 0 Then
 g.Properties("Pencolor").Value = colour
Else
  For i = 0 To g.Graphics.Count - 1
    colourgraphics g.Graphics.Item(i), colour 'recursivly itterate though the graphics collections
  Next i
End If

End Function

I've made a very simple colour dialog form (name=UFcolorpick) which is called, but is subsequently unloaded. There's nothing special about the form code but shown here for completeness.


Private Sub CommandButton1_Click()

Dim r As Byte
Dim g As Byte
Dim b As Byte
Dim c As Long


If testcol = True Then
c = RGB(CByte(TextBox1.Text), CByte(TextBox2.Text), CByte(TextBox3.Text))
Else
c = RGB(255, 0, 0)
End If
chosencolour = c



Me.hide

End Sub

Private Sub Image10_Click()
TextBox1.Value = 255
TextBox2.Value = 255
TextBox3.Value = 255
End Sub

Private Sub Image2_Click()

TextBox1.Value = 255
TextBox2.Value = 0
TextBox3.Value = 0

End Sub



Private Sub displayCol(col As Long)

Image1.BackColor = col

End Sub


Private Function testcol() As Boolean


testcol = True


If TextBox1.Value < 0 Or TextBox1.Value > 255 Then
testcol = False

End If


If TextBox2.Value < 0 Or TextBox2.Value > 255 Then
testcol = False

End If

If TextBox3.Value < 0 Or TextBox3.Value > 255 Then
testcol = False

End If






End Function


Private Sub Image3_Click()
TextBox1.Value = 0
TextBox2.Value = 255
TextBox3.Value = 0
End Sub

Private Sub Image4_Click()
TextBox1.Value = 0
TextBox2.Value = 0
TextBox3.Value = 255
End Sub

Private Sub Image5_Click()
TextBox1.Value = 0
TextBox2.Value = 255
TextBox3.Value = 255
End Sub

Private Sub Image6_Click()
TextBox1.Value = 255
TextBox2.Value = 0
TextBox3.Value = 255
End Sub

Private Sub Image7_Click()
TextBox1.Value = 255
TextBox2.Value = 255
TextBox3.Value = 0
End Sub

Private Sub Image8_Click()
TextBox1.Value = 200
TextBox2.Value = 200
TextBox3.Value = 200
End Sub

Private Sub Image9_Click()
TextBox1.Value = 0
TextBox2.Value = 0
TextBox3.Value = 0
End Sub

Private Sub TextBox1_Change()

If testcol = True Then
displayCol RGB(CByte(TextBox1.Text), CByte(TextBox2.Text), CByte(TextBox3.Text))
End If


End Sub

Private Sub TextBox2_Change()

If testcol = True Then
displayCol RGB(CByte(TextBox1.Text), CByte(TextBox2.Text), CByte(TextBox3.Text))
End If

End Sub

Private Sub TextBox3_Change()

If testcol = True Then
displayCol RGB(CByte(TextBox1.Text), CByte(TextBox2.Text), CByte(TextBox3.Text))
End If

End Sub


Private Sub UserForm_Click()

End Sub

Home Page