AutoCAD VBA Block Color Selection

[Barclay]

My situation, is that I am writing a VBA program for acad that inserts 3D blocks into a drawing in set positions. There are two problems.

1) One block type may have several block references tailing from it, and the requirement is that not all the references will be the same color. For example, there's a block of a wall panel. Some panels will be blue, some red etc. Currently, the block is created in layer 0, and the reference is inserted onto a certain layer that is the correct color, with the block color set to 'bylayer'. Is there a better way to do this?

2) Some of the blocks are actually a collection of 2 or 3 block references, signifying different parts (for example a nut and a bolt being put together in a single block). The different parts will have different colors, and again as with part 1, not every first level reference will have the same color. Currently, using the following code, I can change the required components in the block to different colors, but of course all the block references that follow change with it, instead of just changing the block reference in question.

[VBA] Sub BlockReferencing()

'Declare the Variables
Dim MyBlock As AcadEntity
Dim LayerCount As Double
LayerCount = 0

'Loop through all entities in block definition
For Each MyBlock In ThisDrawing.Blocks("hdpe.fence_3d")

'Change layer of each reference in block
If TypeOf MyBlock Is AcadBlockReference Then
LayerCount = LayerCount + 1
MyBlock.Layer = "layer" & CStr(LayerCount)
End If
Next myblock

End Sub[/VBA]


As you can see, the above code gets the block definition, searches through every entity in the definition, and if it is a block reference, changes the layer.

What I want it to do, is instead of searching through the block definition itself, I want to search through the block reference for its external references (the block references in the block itself), and change their layers. This way i can have one wall assembly that has a blue frame and a green window, another that has a purple frame and a blue window etc...

I have a direct access to the reference at the moment as i inserted the block is inserted using:


[VBA] Dim InsertedBlock as AcadBlockReference
Set InsertedBlock as ThisDrawing.Modelspace.InsertBlock(Blockname,1,1,1,0)[/VBA]


so InsertedBlock is a handle for the block in question

Has anyone had any experience with this sort of thing, or have any ideas? Any help is very appreciated before my brain implodes.

[Tommy]

Hi Ya Barclay,

Welcome to vbax!

I edited your post to show the code posted with vba tags.

OK through with the Mod stuff

We sure can't handle brain implodes - sometimes gets messy

I am unclear what you want, or want to do. But to get the discussion going....

We could copy the block to a new block and modify to fit our needs. We could make little blocks to merge into a block we need ....

We could draw it all from scratch and make it hard for anyone to edit so they come back to you for error reports.......

[Barclay]

Ah, I didn't realise about the VBA tags, thanks for that.

Okay, my biggest problem is the second thing. I'll try and explain it clearer. I'm actually building modular playground equipment, but that's not easy to give good exambles with.

Let's pretend that I'm designing a childs playroom. I'm creating a 3D model of the room using acad, and I create it by drawing a box for the walls, floor and ceiling, and then I insert the furniture.

The furniture is stored as blocks. There's 'Chair', and 'Table' and so forth.

These furniture blocks (we'll call them 'level A' blocks) are actually nested blocks, composed of other blocks (level B blocks). For example, the chair is actually 3 blocks inserted into one: 'Chair Back', 'Chair Seat' and 'Chair Frame'.

When I insert the first Chair, I want it to have a black frame, a red back and a blue seat. When I insert the second Chair, I want it to have a blue frame, a purple back and an orange seat etc.

Basically, I want to

• Have one Block Definition (Chair), and several Block References inserted from this definition (Chair 1, Chair 2 etc).
  
• The Block Definition (chair) is a 'group' of 3 or 4 smaller blocks (chair back, chair seat, chair frame)
• The layers that each of the smaller blocks sits on will be different between each reference (Chair 1 seat is on Layer 1, Chair 2 seat is on Layer 2, Chair 3 seat is on Layer 3)
  

Currently I'm doing this by drawing the level B blocks on Layer 0, with color set to 'by layer'. Before I insert the level A block, I loop through the entities in the block reference, and change the layers accordingly to give the parts the desired colors. I then insert the block reference, explode it to prevent the colors changing when I update the block reference for the next insertion of 'chair'.

This really is a messy way of doing it though, and I cannot go back and reference the 'chair' block references as whole items after this as they're exploded.

I know that I can cycle through the entities in a level A block definition to find the level B block references it is constructed from, but I cannot cycle through a Level A block reference itself, only its definition. Is there any way to do this?

[Tommy]

Hi Barclay,

I got very busy all of a sudden sorry.

This works for 2000i. I used your code and changed it to work

[vba]Sub BlockReferencing()

'Declare the Variables
Dim MyBlock As AcadEntity
Dim LayerCount As Double
LayerCount = 0
Dim Pt(0 To 2) As Double
Dim InsertedBlock As AcadBlockReference
Dim BlockObj As AcadBlock, BlckObj As AcadBlock
Dim BlockName As String, mI&
BlockName = "C:\Program Files\AutoCAD 2000i\4.dwg"
Pt(0) = 0: Pt(1) = 0: Pt(2) = 0
'this just makes sure the block is there
Set InsertedBlock = ThisDrawing.ModelSpace.InsertBlock(Pt, BlockName, 1, 1, 1, 0)
Set BlckObj = ThisDrawing.Blocks.Add(Pt, "4")
BlckObj.Name = "Not10" '<---you need change the name of the block each time
For Each MyBlock In BlckObj
'Change layer of each reference in block
If TypeOf MyBlock Is AcadBlockReference Then
LayerCount = LayerCount + 1
If MyBlock.Name = "1" Then
MyBlock.Layer = "Text"
ElseIf LayerCount = "2" Then
MyBlock.Layer = "Center"
ElseIf LayerCount = "3" Then
MyBlock.Layer = "Label"
End If
End If
Next MyBlock
ThisDrawing.Regen acActiveViewport
End Sub
[/vba]
HTH