Get Attribute value

[tonythm]

Hello Everyone,

I have many Block (same name block, but different value).

How to get value in each block using VBA?

[grobnik]

Could you try to have an approach like:

Sub BL_Attr()
Dim ReturnObj As AcadObject
Dim MyObj As AcadBlockReference
Dim MyAtt As Variant
For Each ReturnObj In ThisDrawing.ModelSpace
    If TypeOf ReturnObj Is AcadBlockReference Then
       'If ReturnObj.Name = "MYBLOCKNAME" Then
            If ReturnObj.HasAttributes = True Then
                Set MyObj = ReturnObj
                MyAtt = MyObj.GetAttributes
                For X = LBound(MyAtt) To UBound(MyAtt)
                    Debug.Print MyAtt(X).TextString, MyAtt(X).TagString                 
                Next X
            End If
       ' End If
    End If
Next
End Sub

The list of all attributes will be stored into the array MyAtt, and the sequence of block attribute will be the same as showed into the window which appear if you double click on block for attribute manually modification.

The value of attribute will be stored into .TextString properties and the "TAG" of the attribute will be stored into .TagString attributes.

If you want to be sure of selected specific block name you can remove the comment from 

'If ReturnObj.Name = "MYBLOCKNAME" Then

replacing MYBLOCKNAME text with your block name and related below comment

'end if

Let us know the result

[tonythm]

Thank you,

Value of each attribute then I got, but problem here, Ex:

I have 3 Blocks (same block name)each block is reversion drawing, inside block have 3 attribute (same name, but diff value). I export value to excel file, but since they have the same name, the values of rev C are overwrite to value rev B on excel.

"TITLE-1", "TITLE-2", "TITLE-3" in each block. 

For Each ent In oDoc.ModelSpace
        If TypeOf ent Is AcadBlockReference Then
            Set blk = ent
            If UCase(blk.EffectiveName) = "REV" Then
                    atts = blk.GetAttributes()
                    For i = 0 To UBound(atts)
                    Set att = atts(i)
                            If att.TextString = "B" Then
                                Range("B23") = att.TextString
                            ElseIf att.TagString = "TITLE-1" Then
                                Range("B21") = att.TextString
                            ElseIf att.TagString = "TITLE-2" Then
                                Range("B19") = att.TextString
                            ElseIf att.TagString = "TITLE-3" Then
                                Range("B20") = att.TextString
                        End If
                    Next
            End If
        End If
    Next

[grobnik]

Hi,

it's not so good have a block with same attribute name, I'm suggesting to modify the title block with different attribute name.

[Ed__Jobe]

@tonythm When you copy an attribute definition and don't change it's tag name, you run into this kind of problem. There is no way to programmatically differentiate between them. In the below image, I entered the attribute values in what I thought was the correct order, but you can see that AutoCAD has the values from bottom to top. In the EATTEDIT dialog, the duplicate atts are highlighted in red to let you know a problem exists. Now, if you redefine the block to have unique tag names, you still have the problem that each AcadBlockReference has it's original attribute collection. You will have to use the ATTSYNC command after redefining. After that, the code should work. If this is not the case, then we don't understand your problem. Submit a sample drawing.

[tonythm]

Thank you so much.

Due to security reasons, I can't send drawing. Maybe it's my lack of presentation.

In Block, tag name different, prompt different, value different also. In drawing, have many block with same block name.

I don't know with VBA how to get value on block. Please help me.

[grobnik]

Can you export a block only? Use wblock it create a dwg only with block. In this way we can understand, because you are saying a different thing compared with starting msg. Use the code above, and share the content.

Bye

[tonythm]

@grobnik , @Ed__Jobe  the attached image will be more clear for my example.

I have many similar blocks. 

I don't know if there's some thing wrong with my code.

Sub GetProperties()
    Dim oWkbk As Workbook
    Set oWkbk = ThisWorkbook
    Dim oSheet As Worksheet
    Set oSheet = oWkbk.ActiveSheet
    'Define sheet name where information resides
    Dim sSheetName As String
    sSheetName = "iProperties"
    Dim oAcad As AcadApplication
    Set oAcad = GetObject(, "AutoCAD.Application")
    Dim oDoc As AcadDocument
    Set oDoc = oAcad.ActiveDocument
    
    Dim ent As AcadEntity
    Dim blk As AcadBlockReference
    Dim blkNameA4Format As String
        blkNameA4Format = "A4"
    Dim blkNameA4Titleblock As String
        blkNameA4Titleblock = "TTL-New-S"
    Dim blkNameA4Titleblock2 As String
        blkNameA4Titleblock2 = "REVSIGN-S"
    Dim blkNameA3Format As String
        blkNameA3Format = "A3"
    Dim blkNameA2Format As String
        blkNameA2Format = "A2"
    Dim blkNameA1Format As String
        blkNameA1Format = "A1"
    Dim blkNameTitleblock As String
        blkNameTitleblock = "TTL-New"
    Dim blkNameTitleblock2 As String
        blkNameTitleblock2 = "REVSIGN-S"
    Dim blkNameTitleblock3 As String
        blkNameTitleblock3 = "REVSIGN"
    For Each ent In oDoc.ModelSpace
        If TypeOf ent Is AcadBlockReference Then
            Set blk = ent
            If UCase(blk.EffectiveName) = UCase(blkNameTitleblock3) Then
                
                    atts = blk.GetAttributes()
                    For i = 0 To UBound(atts)
                    Set att = atts(i)
                        If att.TagString = "TITLE-1" Then                    
                            Range("B18") = att.TextString
                        ElseIf att.TagString = "TITLE-2" Then
                            Range("B19") = att.TextString
                        ElseIf att.TagString = "TITLE-3" Then
                            Range("B20") = att.TextString
                        ElseIf att.TagString = "TITLE-4" Then
                            Range("B21") = att.TextString
                        ElseIf att.TagString = "DATE" Then
                            Range("B22") = att.TextString
                        End If
                    Next
              
            End If
        End If
    Next
    MsgBox "Done!"
End Sub

[Ed__Jobe]

At each iteration, you write to the same range, B18..B22. You need to increment the row numbers rather than hard coding the values. 

[tonythm]

@Ed__Jobe I increased the number of rows (B26...B30....), but because of the same tag name the value received is only ONE.

How to get the value of each block in each separate range in excel?

Sub GetProperties2()
    Dim oWkbk As Workbook
    Set oWkbk = ThisWorkbook
    Dim oSheet As Worksheet
    Set oSheet = oWkbk.ActiveSheet
    'Define sheet name where information resides
    Dim sSheetName As String
    sSheetName = "iProperties"
    Dim oAcad As AcadApplication
    Set oAcad = GetObject(, "AutoCAD.Application")
    Dim oDoc As AcadDocument
    Set oDoc = oAcad.ActiveDocument
    
    Dim ent As AcadEntity
    Dim blk As AcadBlockReference
    Dim blkNameA4Format As String
        blkNameA4Format = "A4""
    Dim blkNameA4Titleblock As String
        blkNameA4Titleblock = "TTL-New-S"
    Dim blkNameA4Titleblock2 As String
        blkNameA4Titleblock2 = "REVSIGN-S"
    Dim blkNameA3Format As String
        blkNameA3Format = "A3"
    Dim blkNameA2Format As String
        blkNameA2Format = "A2"
    Dim blkNameA1Format As String
        blkNameA1Format = "A1"
    Dim blkNameTitleblock As String
        blkNameTitleblock = "TTL-New"
    Dim blkNameTitleblock2 As String
        blkNameTitleblock2 = "REVSIGN-S"
    Dim blkNameTitleblock3 As String
        blkNameTitleblock3 = "REVSIGN"
    For Each ent In oDoc.ModelSpace
        If TypeOf ent Is AcadBlockReference Then
            Set blk = ent
            If UCase(blk.EffectiveName) = UCase(blkNameTitleblock3) Then
                
                    atts = blk.GetAttributes()
                    For i = 0 To UBound(atts)
                    Set att = atts(i)
                        If att.TagString = "TITLE-1" Then
                            Range("B18") = att.TextString
                        ElseIf att.TagString = "TITLE-2" Then
                            Range("B19") = att.TextString
                        ElseIf att.TagString = "TITLE-3" Then
                            Range("B20") = att.TextString
                        ElseIf att.TagString = "TITLE-4" Then
                            Range("B21") = att.TextString
                        ElseIf att.TagString = "DATE" Then
                            Range("B22") = att.TextString
                        End If
                        If att.TagString = "TITLE-1" Then
                            Range("B26") = att.TextString
                        ElseIf att.TagString = "TITLE-2" Then
                            Range("B27") = att.TextString
                        ElseIf att.TagString = "TITLE-3" Then
                            Range("B28") = att.TextString
                        ElseIf att.TagString = "TITLE-4" Then
                            Range("B29") = att.TextString
                        ElseIf att.TagString = "DATE" Then
                            Range("B30") = att.TextString
                        End If
                        If att.TagString = "TITLE-1" Then
                            Range("B34") = att.TextString
                        ElseIf att.TagString = "TITLE-2" Then
                            Range("B35") = att.TextString
                        ElseIf att.TagString = "TITLE-3" Then
                            Range("B36") = att.TextString
                        ElseIf att.TagString = "TITLE-4" Then
                            Range("B37") = att.TextString
                        ElseIf att.TagString = "DATE" Then
                            Range("B38") = att.TextString
                        End If
                    Next
              
            End If
        End If
    Next
    MsgBox "Done!"
End Sub

[grobnik]

Sorry but I don't understand why you cannot replace date with date-1 date-2 date-3 you have only redefine block and all the same block will be updated, unfortunately you will loose attribute value

[tonythm]

Because system drawings in my company it not change, I can't anyway. I only want get value and input to Inventor.

[Ed__Jobe]

You're still hard coding the row numbers and writing to the same range each loop, just doing it 3 times. Here's a simplified example.

Dim row as int
row = 1
for each blockref
   'get atts
   for each att
      row = row +1 'here is the important part
      If att.TagString = "TITLE-1" Then
        Range("B" & row) = att.TextString
      If att.TagString = "TITLE-2" Then
        Range("B" & (row +1)) = att.TextString
      If att.TagString = "TITLE-3" Then
        Range("B" & (row +2)) = att.TextString
      If att.TagString = "DATE" Then
        Range("B" & (row +3)) = att.TextString

[MakCADD]

why dont use attribute export command

why dont enter each attribute values in columns,  and one column with handle to identify the block

and tagstrings as headers,  similar output as in attrubute export command

[tonythm]

Hi @Ed__Jobe 

I have 3 blocks as shown below. How to get the information atts of those 3 blocks into excel of areas B, C, D.

All 3 blocks have the same name: REVSIGN. Tag name atts is different.

 

When I run the code, it only takes the last value (NAME 9,...12 & DATE value) and fills all 3 areas B, C, D in excel.

How to fill values NAME 1,..4 & DATE into area B, NAME 5,..8 & DATE into area C, and NAME 9,...12 & DATE into area D.

I have attached CAD and excel files.
I just learned about VBA so I really haven't used it very well yet. Can you help me?

Thank you.

[Ed__Jobe]

I'm on vacation this week. I don't know if I'll have time until next week.

[grobnik · Accepted solution]

Hi @tonythm,

Try to apply this code

A = 1 ' to be added before For Each ent...
For Each ent In oDoc.ModelSpace

If UCase(blk.EffectiveName) = UCase(blkNameTitleblock3) Then
'simple test
atts = blk.GetAttributes()
For i = 0 To UBound(atts)
Range("F" & A) = atts(i).TagString
Range("G" & A) = atts(i).TextString
A = A + 1
Next

here the result

The above result it's exactly the sequence of attributes inserted for each block in the drawing.

[tonythm]

Hi @grobnik 

Awesome, helped me quickly at work. Thank you very much.

[grobnik · Accepted solution]

Hi @tonythm ,

if you want you keep the code as is, later hide the columns F & G and apply the same value in your Excel Form using formula see attached revised xls file.