Change atribute values of autocad blocks

Anonymous · ‎07-19-2020

Hello,

I have been making a small program to change the name of attributes in a block.
The jist of it is:

1º- check if it's one of two types of blocks;

2º- if it is, check if the attribute with the tag "TIPO_EQUIPAMENTO" is "TOPO";
3º- if it is, check if the attribute with the tag "TIPO_AREA" is "PRAC";

4º- if it is, get the attribute with the tag "UN" (X=UN value);

5º- add the x to the attribute with the tag "MERCADO" (Y= MERCADO value; MERCADO value = y & x).

I think I have the logic all there, but it says I have too many End ifs and it does not make sense.

The code is:

'unlock layers
ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = False
ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = False
ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = False

Dim ss As AcadSelectionSet
    
    Dim filtertype As Variant
    Dim filterdata As Variant
    Dim grpCode(0) As Integer
    Dim grpValue(0) As Variant
    
    grpCode(0) = 2
    filtertype = grpCode
    
    'Blocks to filter
    grpValue(0) = "BLOCO LAT TOP,BLOCO TOPO PEP"
    filterdata = grpValue
    
 
    'if there are no blocks
   If (ThisDrawing.SelectionSets.Count > 0) Then
   ThisDrawing.SelectionSets.Item(0).Delete
   
   End If
   
   'block selection
   Set ss = ThisDrawing.SelectionSets.Add("blocos")
   ss.Select acSelectionSetAll, , , filtertype, filterdata
   
    Dim blk As AcadBlockReference
    
    Dim flg As Boolean
    Dim idx As Long
    Dim attr As Variant
    Dim i As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim x As String
    Dim y As String
    i = 0
    a = 0
    b = 0
    c = 0

    Set blk = ss(0)

   'loop selection and process blocks
     Dim updated As Boolean '' for debugging only
     
   
     
     For Each blk In ss
        If (blk.HasAttributes) Then
            attr = blk.GetAttributes()
            updated = False
            For i = 0 To UBound(attr)
                If UCase(attr(i).TagString) = "TIPO_EQUIPAMENTO" And _
                    attr(i).TextString = "TOPO" Then
                        For a = 0 To UBound(attr)
                        If UCase(attr(i).TagString) = "TIPO_AREA" And _
                        attr(i).TextString = "PRAC" Then
                            For b = 0 To UBound(attr)
                            If UCase(attr(i).TagString) = "UN" Then
                                x = attr(i).TextString
                                For c = 0 To UBound(attr)
                                If UCase(attr(i).TagString) = "MERCADO" Then
                                y = attr(i).TextString
                                attr(i).TextString = y & x
                                updated = True
                                End If
                                Exit For
                            End If
                            Exit For
                        End If
                        Exit For
                End If
                updated = True
            
            Next
        End If
    Next
 

'update drawing
ThisDrawing.Regen acAllViewports

'lock layers
ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = True
ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = True
ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = True

'done
MsgBox "Update completed!"

Can someone tell where it failed? in attachment is a target block if you want to test it out.

grobnik · ‎07-19-2020

Hi @Anonymous ,

I didn't yet tested your code, but, from what I'm seeing you used in several part of code the Exit For sentence, but this is out of "if " and "end if " structure, and this could cause some confusion and unwanted code functionality, usually exit for shall be inside the "if " and "end if " structure, in addition try, when you write a code, to use the "TAB" editing option in order to have the alignment of a FOR NEXT, or IF and ENDIF or any other loop structure, so you can check immediately the loop structure.

I mean:

For x= 1 to 100

If a=b then

c=2

Exit For

end if

So when the condition a=b it's true, the value 2 will be assigned to c, and there should be any other reason to continue the search with for and next loop, this is the reason of using Exit For functionality. If you are using Exit for outside the "if " and "end if " the loop will be terminated after first cycle, because the Exit For will be executed without any condition.

As you can see "if " and "end if " are aligned, as well "For " and "Next ", in this way you have an immediately look at the code for missing part.

However in the next days I'll check your code and I'll try to fix if necessary, in the mean time look at the code with this prospective.

Bye

grobnik · ‎07-20-2020

Hi @Anonymous

Sorry to reply again without testing your code, but in order to reduce the amount of for next cycle, you can select directly the attribute position inside the attribute array, I mean if you look at

attr = blk.GetAttributes()

attr array by debug option, you will see exactly the same sequence of TAGSTRING, and related VALUE (TEXTSTRING), of active block, as in case you editing block directly on drawing for attribute modification. So you don't need to cycle every time the list of attribute and find TAGSTRING for modification of attribute value (TEXTSTRING) or check name, you already know that for BLOCK "BLOCO LAT TOP" or "BLOCO TOPO PEP" the sequence of attribute where find TIPO_EQUIPAMENTO or TIPO_AREA is the position 0 or 2 or n, so you can directly look at attribute with "... attr(0) [or position required].TagString, and related "... attr(0) [or position required].TextString". Please remember that attrubute array will always start from 0 (zero) index.

Command as " SELECT CASE ----- (VARIABLE)" and CASE (followed by END SELECT after all CASEs check) could save time and code will be more readable.

Within tomorrow I'll check your code, in any case, again, I'm suggesting to review the code with this addition focal point.

Bye

grobnik · ‎07-20-2020

@Anonymous here is the code working as I posted previously setting only the identified attribute

Sub pP()
ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = False
'ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = False
ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = False

Dim ss As AcadSelectionSet
    
    Dim filtertype As Variant
    Dim filterdata As Variant
    Dim grpCode(0) As Integer
    Dim grpValue(0) As Variant
    
    grpCode(0) = 2
    filtertype = grpCode
    
    'Blocks to filter
    grpValue(0) = "BLOCO LAT TOP,BLOCO TOPO PEP"
    filterdata = grpValue
    
 
    'if there are no blocks
   If (ThisDrawing.SelectionSets.Count > 0) Then
   ThisDrawing.SelectionSets.Item(0).Delete
   
   End If
   
   'block selection
   Set ss = ThisDrawing.SelectionSets.Add("blocos")
   ss.Select acSelectionSetAll, , , filtertype, filterdata
   
    Dim blk As AcadBlockReference
    
    Dim flg As Boolean
    Dim idx As Long
    Dim attr As Variant
    Dim i As Integer
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim x As String
    Dim y As String
    i = 0
    a = 0
    b = 0
    c = 0

    Set blk = ss(0)

   'loop selection and process blocks
     Dim updated As Boolean '' for debugging only
     
   
     
 For Each blk In ss
        If (blk.HasAttributes) Then
            attr = blk.GetAttributes()
            updated = False
           ' For i = 0 To UBound(attr)
                If UCase(attr(8).TagString) = "TIPO_EQUIPAMENTO" And attr(8).TextString = "TOPO" Then
                        'For a = 0 To UBound(attr)
                        If UCase(attr(4).TagString) = "TIPO_AREA" And attr(4).TextString = "PRAC" Then
                            'For b = 0 To UBound(attr)
                            If UCase(attr(1).TagString) = "UN" Then
                                x = attr(1).TextString
                                'For c = 0 To UBound(attr)
                                If UCase(attr(3).TagString) = "MERCADO" Then
                                    y = attr(3).TextString
                                    attr(3).TextString = y & x
                                    updated = True
                                End If
                                'Exit For
                            End If
                            'Exit For
                        End If
                       ' Exit For
                End If
                updated = True
            
           ' Next
        End If
    Next

'update drawing
ThisDrawing.Regen acAllViewports

'lock layers
ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = True
'ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = True
ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = True

'done
MsgBox "Update completed!"

End Sub

Please note that the layer Layers("MC_BLOCO_TEXTOS_COMERCIAL") does not exist in the sample dwg attached.

See attached picture for result.

As explained the attr array will have the following structure:

Test of above code has been done only for block "BLOCO TOPO PEP", the second one you indicated on your code "BLOCO LAT TOP" it's not available on sample drawing, we assuming should have the same attributes, due to in your code didn't made difference between.

Let us know.

Bye

Anonymous · ‎07-21-2020

wow, thank you so much, I will check with the other files and get back at you

thanks once again 🙂

grobnik · ‎07-21-2020

Hi, @Anonymous ,

It's an hobby for me, I'm sorry I removed all for next cycle for searching attributes (placing only a ' as comment), in your code, but as I explained you already have the reference of attributes position in the global block attributes array and in my opinion make no sense nesting for next loop for attribute identification. Of course you can do it, but there will be more possibility to made mistakes, and forgot some loop ending as happened into your code.

Bye

Anonymous · ‎07-21-2020

it works 🙂
in hindsight, it really doesn't make sense to keep searching for the correct attribute if its always going to be in the same line.

thanks for the tips 😄

Community

Change atribute values of autocad blocks

Change atribute values of autocad blocks

Change atribute values of autocad blocks