Change color for of entetys

Change color for of entetys

Anonymous
Not applicable
1,315 Views
3 Replies
Message 1 of 4

Change color for of entetys

Anonymous
Not applicable

Hi together, 

 

I'm quite new to the Forum and VBA in Autocad, but I'm pretty sure what I need is quite easy, so maby someone can help me out. 

 

We get colorfully plans from our cosumers and need them to be in gray (color 251) to work with the plans. 

 

Often the cooler of some Objekts in blocks are set to a spesific color and not to byLayer. I got the job task to find an easy way to change the cooler of all Objekts in the drawing to 251. VBA should work. 

 

I think I need some script like this:

 

For each blk in ThisDrwaing.Blocks

--> open block editor

--> select all

--> set color to by layer

Next

 

Can some one help me out with code input? 

 

Thank you very much! 

 

P.S: I can provide an example file later one. 

0 Likes
1,316 Views
3 Replies
Replies (3)
Message 2 of 4

Ed__Jobe
Mentor
Mentor

Here is a sub I wrote to change block entities color to ByLayer. You can modify it.

 Sub BlockEntsByLayer()
    Dim oblk As AcadBlock
    Dim oBlk1 As AcadBlock
    Dim oBlkRef As AcadBlockReference
    Dim oBlkRef1 As AcadBlockReference
    Dim oEnt As AcadEntity
    Dim oEnt1 As AcadEntity
    Dim SS As AcadSelectionSet

    Set SS = GetSS_BlockFilter
    For Each oBlkRef In SS
        Set oblk = ThisDrawing.Blocks(oBlkRef.Name)
        If Not oblk.IsXRef Then
            For Each oEnt In oblk
                If TypeOf oEnt Is AcadBlockReference Then
                    Set oBlkRef1 = oEnt
                    Set oBlk1 = ThisDrawing.Blocks(oBlkRef1.Name)
                    For Each oEnt1 In oBlk1
                        With oEnt1
                            If Not ThisDrawing.Layers(.Layer).Lock Then
                                .Layer = "0"
                                .color = acByLayer
                            End If
                        End With
                    Next oEnt1
                Else
                    With oEnt
                        If Not ThisDrawing.Layers(.Layer).Lock Then
                            .Layer = "0"
                            .color = acByLayer
                        End If
                    End With
                End If
            Next oEnt
        End If
    Next oBlkRef
    ThisDrawing.Regen acAllViewports
End S

Ed


Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.

EESignature

0 Likes
Message 3 of 4

Anonymous
Not applicable

Thanks. This looks quite promising.

A few questions:

Set SS = GetSS_BlockFilter 

Whats this? Where does the Selection Set SS gets it's information from?

 For Each oBlkRef In SS
        Set oblk = ThisDrawing.Blocks(oBlkRef.Name)

 This forces the program to go block by block right? And Hands the "oblk" one specific block by name? 

If TypeOf oEnt Is AcadBlockReference Then
                    Set oBlkRef1 = oEnt
                    Set oBlk1 = ThisDrawing.Blocks(oBlkRef1.Name)

 Here you check if the entity is although a block or? If so how can I be sure there is only one Block in a Block and not so on?

 

First question would be the most important as I'm relay not understanding whats happening there.

 

 Thank you very much for your help.

0 Likes
Message 4 of 4

Ed__Jobe
Mentor
Mentor

1. GetSS_BlockFilter is a sub I wrote to get a ss made of only blocks. I'm pretty sure I already posted it before, so do a search of this forum.

2. Yes

3. You need to understand the object model for blocks. An AcadBlockReference is what the GetSS_BlockFilter sub gets. It is equal to a Block insertion. An AcadBlock is the Block's definition. This snippet iterates block references and uses its Name property to get the block definition, which is what holds the entities whose color you want to change. The AcadBlockReference object only has insertion properties, like InsertionPoint, Rotation and Scale.

Ed


Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.

EESignature

0 Likes