Blocks with Attributes

[Anonymous]

I am new to AutoCAD VBA, I was wondering if anyone could help me. I am trying to write a Procedure that will loop through all the blocks, included nested blocks, in a drawing and change it objects, include attribute tags, to the color ByLayer. I am running AutoCAD 2000i Any help would be appreciated.

Thanks,
Joe

[Anonymous]

Public Sub changeBlockColor(colorValue As Integer)
Dim block As AcadBlock
Dim entity As AcadEntity

For Each block In ThisDrawing.Blocks
For Each entity In block
entity.color = colorValue
Next entity
Next block
End Sub

Public Sub testChangeBlockColor()
changeBlockColor acByLayer
End Sub

[Anonymous]

Hi Joe, This is a two step process. The first is to find all block definitions and change all of the entities defined within to color bylayer. The second step is to grab all block references and change all of their attribute references to color bylayer. Of course the tricky part there is the nested block condition. The first listing here takes care of step one. Public Sub MakeColorByLayer(acadDB As AcadDatabase) Dim block As AcadBlock Dim ent As AcadEntity For Each block In acadDB.Blocks If Not block.IsLayout And Not block.IsXRef Then For Each ent In block ent.Color = acByLayer Next ent End If Next block End Sub This next listing handles the second step. I chose a recursive function here to handle the nested blocks. I seriously doubt that anyone has blocks nested deep enough where there would be a difference enough to warrant coding up an iterative function to handle this. Also note that I didn't account for constant attributes. Public Sub MakeAttRefsColorByLayer(blockRef As AcadBlockReference) Dim acadDoc As AcadDocument Set acadDoc = blockRef.Document Dim blockName As String blockName = blockRef.Name Dim blockDef As AcadBlock Set blockDef = acadDoc.Blocks.Item(blockName) 'Test if the block is a simple block. If Not blockDef.IsLayout And Not blockDef.IsXRef Then Dim attRefs As Variant Dim attRef As AcadAttributeReference Dim attRefIndex As Integer 'Set all of the attributes to color bylayer If blockRef.HasAttributes Then attRefs = blockRef.GetAttributes() For attRefIndex = LBound(attRefs) To UBound(attRefs) Set attRef = attRefs(attRefIndex) attRef.Color = acByLayer Next attRefIndex End If 'Check for nested blocks Dim ent As AcadEntity Dim nestedBlockRef As AcadBlockReference For Each ent In blockDef If TypeOf ent Is AcadBlockReference Then 'Make recursive call to handle nested blocks Set nestedBlockRef = ent Call MakeAttRefsColorByLayer(nestedBlockRef) End If Next ent End If End Sub You can run these two functions like this. For the sake of simplicity I am iterating all of the layouts in search of block references, but you could just as easily create a filtered selection set if you so desired. Public Sub TestMakeColorByLayer() 'Step one Call MakeColorByLayer(ThisDrawing.Database) 'Step Two Dim layout As AcadLayout Dim ent As AcadEntity Dim blockRef As AcadBlockReference For Each layout In ThisDrawing.Layouts For Each ent In layout.block If TypeOf ent Is AcadBlockReference Then Set blockRef = ent Call MakeAttRefsColorByLayer(blockRef) End If Next ent Next layout End Sub I also just caught the fact that you are on 2000i. My original code was created in 2004 and utilized the new true color object. I'm pretty sure that I ripped all of that out and replaced all of the TrueColor property calls to the Color property, but it's not tested as such. Let me know if you have any problems. -- Bobby C. Jones www.AcadX.com "JMongi5967" wrote in message news:9922485.1071541144387.JavaMail.jive@jiveforum1.autodesk.com... > I am new to AutoCAD VBA, I was wondering if anyone could help me. I am trying to write a Procedure that will loop through all the blocks, included nested blocks, in a drawing and change it objects, include attribute tags, to the color ByLayer. I am running AutoCAD 2000i Any help would be appreciated. > > Thanks, > Joe

[Anonymous]

Just for the record, This is not a "two step process", and you don't need to worry about 'nested' blocks or application of 'recursive' concepts, because you're going to process *all* objects in the drawing, except for those in layouts. In fact, the "recursive approach" posted in another reply, will needlessly process the same block multiple times, when insertions of it appear in more than one parent block. Duh! This Sub will process every block, including layouts, but will not change the color of entities that are directly owned by layouts: Public Sub ProcessBlock(Block As AcadBlock) Dim IsNested As Boolean IsNested = not Block.IsLayout Dim Entity As AcadEntity ForEach Entity in Block If IsNested then Entity.Color = acByLayer End If if TypeOf Entity is AcadBlockReference then Dim BlockRef As AcadBlockReference Set BlockRef = Entity If BlockRef.HasAttributes then Dim AttRef As AcadAttributeReference Dim Attributes As Variant Attributes = BlockRef.GetAttributes Dim i As Integer For i = LBound(Attributes) to UBound(Attributes) Set AttRef = Attributes(i) AttRef.Color = acByLayer Next i End If End If Next Entity End Sub With the above, you just need this: Public Sub ProcessDrawing Dim ABlock As AcadBlock ForEach ABlock in ThisDrawing.Blocks If not ABlock.IsXref then ProcessBlock ABlock End if Next Block End Sub -- AcadXTabs: MDI Document Tabs for AutoCAD http://www.acadxtabs.com "JMongi5967" wrote in message news:9922485.1071541144387.JavaMail.jive@jiveforum1.autodesk.com... > I am new to AutoCAD VBA, I was wondering if anyone could help me. I am trying to write a Procedure that will loop through all the blocks, included nested blocks, in a drawing and change it objects, include attribute tags, to the color ByLayer. I am running AutoCAD 2000i Any help would be appreciated. > > Thanks, > Joe

[Anonymous]

Note that both of those subs were not tested at all, and there's a stupid bug in the second sub: Public Sub ProcessDrawing Dim ABlock As AcadBlock ForEach ABlock in ThisDrawing.Blocks If not ABlock.IsXref then ProcessBlock ABlock End if Next ABlock ' bug fixed End Sub -- AcadXTabs: MDI Document Tabs for AutoCAD http://www.acadxtabs.com

[Anonymous]

Big Duh indeed T man! What was the other poster, or is that poser, thinking :-) Thanks for the simplified answer. -- Bobby C. Jones www.AcadX.com "Tony Tanzillo" wrote in message news:3fe07ab5$1_2@statler... > Just for the record, This is not a "two step process", > and you don't need to worry about 'nested' blocks or > application of 'recursive' concepts, because you're > going to process *all* objects in the drawing, except > for those in layouts. > > In fact, the "recursive approach" posted in another > reply, will needlessly process the same block multiple > times, when insertions of it appear in more than one > parent block. Duh! > > This Sub will process every block, including layouts, > but will not change the color of entities that are > directly owned by layouts: > > Public Sub ProcessBlock(Block As AcadBlock) > Dim IsNested As Boolean > IsNested = not Block.IsLayout > Dim Entity As AcadEntity > ForEach Entity in Block > If IsNested then > Entity.Color = acByLayer > End If > if TypeOf Entity is AcadBlockReference then > Dim BlockRef As AcadBlockReference > Set BlockRef = Entity > If BlockRef.HasAttributes then > Dim AttRef As AcadAttributeReference > Dim Attributes As Variant > Attributes = BlockRef.GetAttributes > Dim i As Integer > For i = LBound(Attributes) to UBound(Attributes) > Set AttRef = Attributes(i) > AttRef.Color = acByLayer > Next i > End If > End If > Next Entity > End Sub > > With the above, you just need this: > > Public Sub ProcessDrawing > Dim ABlock As AcadBlock > ForEach ABlock in ThisDrawing.Blocks > If not ABlock.IsXref then > ProcessBlock ABlock > End if > Next Block > End Sub > > -- > AcadXTabs: MDI Document Tabs for AutoCAD > http://www.acadxtabs.com > > > "JMongi5967" wrote in message news:9922485.1071541144387.JavaMail.jive@jiveforum1.autodesk.com... > > I am new to AutoCAD VBA, I was wondering if anyone could help me. I am trying to write a Procedure that will loop > through all the blocks, included nested blocks, in a drawing and change it objects, include attribute tags, to the color > ByLayer. I am running AutoCAD 2000i Any help would be appreciated. > > > > Thanks, > > Joe > >

[Anonymous]

Nice. And at the risk of gittin stomped ;-) There is also the matter of possible constant attributes that would be handled similarly with getconstantattributes. "Tony Tanzillo" wrote in message news:3fe07b96_7@statler... > Note that both of those subs were not tested > at all, and there's a stupid bug in the second > sub: > > Public Sub ProcessDrawing > Dim ABlock As AcadBlock > ForEach ABlock in ThisDrawing.Blocks > If not ABlock.IsXref then > ProcessBlock ABlock > End if > Next ABlock ' bug fixed > End Sub > > > -- > AcadXTabs: MDI Document Tabs for AutoCAD > http://www.acadxtabs.com > > >