topic Re: Get Attribute value in VBA Forum

Get Attribute value

tonythm — Tue, 21 Dec 2021 06:33:06 GMT

Hello Everyone,

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

How to get value in each block using VBA?

Re: Get Attribute value

grobnik — Tue, 21 Dec 2021 07:19:37 GMT

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

Re: Get Attribute value

tonythm — Tue, 21 Dec 2021 08:08:04 GMT

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

Re: Get Attribute value

grobnik — Tue, 21 Dec 2021 11:05:57 GMT

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.

Re: Get Attribute value

Ed__Jobe — Tue, 21 Dec 2021 15:26:21 GMT

@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.

Re: Get Attribute value

tonythm — Wed, 22 Dec 2021 01:14:08 GMT

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.

Re: Get Attribute value

grobnik — Wed, 22 Dec 2021 01:39:06 GMT

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

Re: Get Attribute value

tonythm — Wed, 22 Dec 2021 03:21:23 GMT

@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

Re: Get Attribute value

Ed__Jobe — Wed, 22 Dec 2021 04:05:57 GMT

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

Re: Get Attribute value

tonythm — Wed, 22 Dec 2021 05:06:08 GMT

@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

Re: Get Attribute value

grobnik — Wed, 22 Dec 2021 06:13:24 GMT

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

Re: Get Attribute value

tonythm — Wed, 22 Dec 2021 06:14:11 GMT

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

Re: Get Attribute value

Ed__Jobe — Wed, 22 Dec 2021 15:13:39 GMT

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

Re: Get Attribute value

MakCADD — Thu, 23 Dec 2021 05:25:37 GMT

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

Re: Get Attribute value

tonythm — Mon, 27 Dec 2021 13:37:53 GMT

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.

Re: Get Attribute value

Ed__Jobe — Mon, 27 Dec 2021 17:23:50 GMT

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

Re: Get Attribute value

grobnik — Mon, 27 Dec 2021 19:56:50 GMT

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.

Re: Get Attribute value

tonythm — Tue, 28 Dec 2021 14:30:29 GMT

Hi @grobnik

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

Re: Get Attribute value

grobnik — Tue, 28 Dec 2021 15:32:31 GMT

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.