Change Attribute Layer In Block With VBA

Change Attribute Layer In Block With VBA

Anonymous
Not applicable
3,428 Views
4 Replies
Message 1 of 5

Change Attribute Layer In Block With VBA

Anonymous
Not applicable
I am running into something, and I can't seem to figure it out. I have a subroutine to change the layer of an attribute, but it does not seem to work, and I can't find much on it online, so here i am! I will do my best to format it here, as my insert code button is not showing up in IE 11 or chrome... Private Sub ToZeroLayer(acadAttribute As String) Dim AttRef As AcadAttributeReference Dim Block As Object For Each Block In ThisDrawing.PaperSpace If Block.EntityName = "AcDbBlockReference" Then If Block.HasAttributes Then Array1 = Block.GetAttributes For i = LBound(Array1) To UBound(Array1) If (Array1(i).EntityName) = acadAttribute Then Set AttRef = (Array1(i)) AttRef.Layer = "0" End If Next End If End If Next End Sub It runs through the code without error, but it appears to do nothing.... Any help would be much appreciated! --Thanks as always!
0 Likes
Accepted solutions (1)
3,429 Views
4 Replies
Replies (4)
Message 2 of 5

Anonymous
Not applicable
Did you try and debug it line by line? At a first glance I'd say it would never pass the "If (Array1(i).EntityName) = acadAttribute Then" check since attribute "name" is its "tagstring" property (or something similar - I'm not at my PC now) actually.
Then I can't tell you anything about attributereference object properties and treatment since I never used it.
0 Likes
Message 3 of 5

norman.yuan
Mentor
Mentor
Accepted solution

Using

 

If AcadEntity.EntityName = "xxxxxx" Then

 

is an error-prone approach, because up/lowercase difference could lead to different result, In your case, use "TypeOf xxxx Is xxxxxxx" would be more error-proofing.

 

Following code change an block's attribute's layer: the attribute was defined in layer "0", and the block reference is inserted in layer "0", running the code changes the layer of the attributes in the block reference to "Layer1". Since "Layer1" has color red, the code result can be visibily verified.

 

Public Sub Test()

    Dim ent As AcadEntity
    Dim blk As AcadBlockReference
    Dim atts As Variant
    Dim att As AcadAttributeReference
    Dim i As Integer
    
    For Each ent In ThisDrawing.ModelSpace
        
        If TypeOf ent Is AcadBlockReference Then
            Set blk = ent
            atts = blk.GetAttributes()
            For i = 0 To UBound(atts)
                Set att = atts(i)
                att.Layer = "Layer1"
                att.Update
            Next
        End If
        
    Next

End Sub

 

Norman Yuan

Drive CAD With Code

EESignature

Message 4 of 5

Anonymous
Not applicable
norman.yuan, That works perfect for what I need. Just added an "if then" to check if the attribute name found in the for loop matches the attribute i am sending from the main sub, and it works just fine. I did not think of using the "TypeOf" operator to avoid errors, that will avoid me having to send with ucase, etc. Thanks for the solution!
0 Likes
Message 5 of 5

Anonymous
Not applicable

just out of curiosity, did you actually use ".EntityName" for attribute name checking?

0 Likes