Solved: Read field in AUTOCAD block attribute

Hi all,

I have a block-reference with attributereferences.

One of these references is a calculated field that gives the area of a polyline.

This is its calculation expression:
%<\AcObjProp Object(%<\_ObjId 2129748024>%).Area \f "%lu2">%

where 2129748024 is the ID of the linked polyline.

I'd like to get the expression above in order to extract the object id number (2129748024). My aim is to get the id number and use it to insert a new attribute into the block that will have a calculated field corresponding to the length of the same polyline.

Thanks in advance.

Hi ALe, I posted solution on swamp as well
Here is a quick and dirty code
[vba]

<CommandMethod("foo")>
_
Public Sub
GetFieldFromAttribute()

Dim doc As Document =
Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveD ocument

Dim db As Database =
doc.Database

Dim ed As Editor = doc.Editor



Try

Dim tab As String =
Autodesk.AutoCAD.ApplicationServices.Application.GetSystemVariable("ctab"). ToString

Dim blockname As String = ed.GetString(vbLf & "Enter blockname:
").StringResult

Dim opts As PromptSelectionOptions = New
PromptSelectionOptions

opts.SingleOnly =
True

opts.MessageForRemoval = vbLf & "Select block
only"

opts.MessageForAdding = vbLf & "Select single
block"

Dim filt As SelectionFilter = New SelectionFilter({New TypedValue(0, "insert"),
New TypedValue(2, blockname), New TypedValue(410,
tab)})

Dim psr As PromptSelectionResult = ed.GetSelection(opts,
filt)

If psr.Status <> PromptStatus.OK Then Exit
Sub

If psr.Value.Count <> 1 Then Exit
Sub

Dim id As ObjectId =
psr.Value.GetObjectIds(0)

If id.IsNull Then Exit
Sub

Using tr As Transaction =
db.TransactionManager.StartTransaction()

Dim obj As DBObject = tr.GetObject(psr.Value.GetObjectIds(0),
OpenMode.ForRead)

If TypeOf obj Is BlockReference
Then

Dim bref As BlockReference = CType(tr.GetObject(id, OpenMode.ForRead),
BlockReference)

Dim attcoll As AttributeCollection =
bref.AttributeCollection

Dim att As
AttributeReference

For Each aid As ObjectId In
attcoll

Dim aobj As DBObject = tr.GetObject(aid,
OpenMode.ForRead)

att = TryCast(DirectCast(aobj, AttributeReference),
AttributeReference)

If att Is Nothing Then Exit
Sub

If att.Tag.Equals("LENGTH", StringComparison.CurrentCultureIgnoreCase)
Then

If att.HasFields
Then

Dim fld As Field = tr.GetObject(att.GetField(),
OpenMode.ForRead)

Dim code As String =
fld.GetFieldCode

Dim pos1 As Int32 =
code.IndexOf("_ObjId")

Dim pos2 As Integer =
code.IndexOf(">%")

Dim leng1 As Integer =
"_ObjId".Length

Dim leng2 As Integer =
">%".Length

Dim idstr As String = code.Substring(pos1 + leng1 + 1, pos2 - (pos1 + leng1) -
1)

MsgBox("ID from field code: " &
idstr)

Dim objId As ObjectId = New ObjectId(New
IntPtr(Convert.ToInt32(idstr)))

Dim fieldchild As DBObject = tr.GetObject(objId,
OpenMode.ForRead)

If TypeOf fieldchild Is Polyline
Then

Dim poly As Polyline = DirectCast(fieldchild,
Polyline)

MsgBox("Compare:" & vbLf & "Return from attribute: " &
att.TextString & vbLf & "Return from Polyline: " &
poly.Area.ToString)

End
If

Exit
For

End
If

End
If

Next

End
If

End Using

Catch ex As
Autodesk.AutoCAD.Runtime.Exception

ed.WriteMessage(ex.Message + vbLf +
ex.StackTrace)

End Try
End Sub
[/vba]

Great Fixo, to tell you the truth I hoped you were around!

I'll give a try tonight and let you know!

Thank you

Quote:

---

Originally Posted by ALe

Great Fixo, to tell you the truth I hoped you were around!

I'll give a try tonight and let you know!

Thank you

---

Sorry I kinda sick a bit and see the forum not too often
Hope this will be working on your end, just change an attribute tag
(I used 'LENGTH' i.e.) etc...
See you

Oleg

I hope nothing serious!

I was curious so I started to run the code, I'm having troubles with formatting.

I'm supposed to run it via VBA? It seems .NET code

Quote:

---

Originally Posted by ALe

I hope nothing serious!

I was curious so I started to run the code, I'm having troubles with formatting.

I'm supposed to run it via VBA?

---

My bad this is VB.NET solution, sorry
I will try to rewrite it on VBA but I' not sure I'll do it
Wait for tomorrow

Sorry, buddy :)

thank you Oleg, sure I'll wait!

Quote:

---

Originally Posted by ALe

thank you Oleg, sure I'll wait!

---

Unfortunately there are no chances to solve such problem with use of pure VBA methods
.
The instruction:
Keep a file.LSP in a working directory, for example as
alinks.lsp

Open drawing
Go to the menu Tools-> AutoLisp-> Load Application
Find in a dialogue window the kept file alinks.lsp and specify it
He will be loaded and carry out all actions automatically

Then you can open and use my VBA a code

Good luck!

[vba]
Option Explicit

Public Function ReadTxtFile(fil As String)
Dim fd As Long
Dim sline As String
Dim ar As Variant
Dim txtColl As New Collection
fd = FreeFile
Open fil For Input Access Read Shared As fd
Do Until EOF(fd)
Line Input #fd, sline
ar = Split(sline, ",")
txtColl.Add ar, CStr(ar(0))
Loop
Close fd
Set ReadTxtFile = txtColl
End Function

Public Sub GetObjectsByField()
Dim oSset As AcadSelectionSet
Dim blkRef As AcadBlockReference
Dim attObj As AcadAttributeReference
Dim attData() As AcadObject
Dim newVal As String
Dim fType(1) As Integer
Dim fData(1) As Variant
Dim attHandle As String
Dim k As Integer

' declare collection to hold pairs of object Handles
Dim hndColl As New Collection
Dim itm As Variant
'Dim ar() As Variant
Dim i As Integer, j As Integer
Dim filename As String
'.csv file was saved from lisp with the same name:
filename = ThisDrawing.Path & "\" & Replace(ThisDrawing.Name, "dwg", "csv")
If Dir(filename) = "" Then '' <-- check if file exist
MsgBox ("File .csv not found. Run lisp before") '' <-- if not then show message and exit program
Exit Sub
End If
Set hndColl = ReadTxtFile(filename)
fType(0) = 0: fType(1) = 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
fData(0) = "INSERT": fData(1) = "myblock" '' <-- change blockname here
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
For Each oSset In ThisDrawing.SelectionSets
If oSset.Name = "$Blocks$" Then
oSset.Delete
Exit For
End If
Next oSset
Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$") '' <-- any name is admissible
On Error GoTo 0
oSset.SelectOnScreen fType, fData
For Each blkRef In oSset
attData = blkRef.GetAttributes
For k = 0 To UBound(attData)
Set attObj = attData(k)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
If attObj.TagString = "LENGTH" Then '' <-- change attribute tag here
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

'/*====================this code block might be removed ================'
Dim Xdictionary As AcadDictionary
Set Xdictionary = attObj.GetExtensionDictionary
Dim fldObject As Object
On Error Resume Next
' check if attribute has field
Set fldObject = Xdictionary.GetObject("ACAD_FIELD")
If Err.Number <> 0 Then
Err.Clear
If fldObject Is Nothing Then
Exit Sub
End If
End If
'======================================================================*/'

'get attribute Handle property
attHandle = attObj.handle
Debug.Print attHandle
Exit For
End If
Next k
' try to find object by attribute handle
Dim foundHandle As String
foundHandle = ""
' loop through collection of pairs to search for associative handle
For Each itm In hndColl
If Trim(CStr(itm(0))) = attHandle Then
foundHandle = Trim(CStr(itm(1)))
'if found then exit from loop
Exit For
End If
Next itm
If foundHandle = "" Then Exit Sub
Dim holderObj As AcadObject
' retrive object from drawing usin its handle
Set holderObj = ThisDrawing.HandleToObject(foundHandle)
'check on object type, do your stuffs with this object
If TypeOf holderObj Is AcadLWPolyline Then
Dim plineObj As AcadLWPolyline
Set plineObj = holderObj
'' add some properties to show result ony:
plineObj.color = acRed
plineObj.Lineweight = acLnWt050
ElseIf TypeOf holderObj Is AcadLine Then
Dim lineObj As AcadLWPolyline
Set lineObj = holderObj
'' add some properties to show result ony:
lineObj.color = acBlue
lineObj.Lineweight = acLnWt020
ElseIf TypeOf holderObj Is AcadCircle Then
Set circObj = holderObj
'' add some properties to show result ony:
circObj.color = acMagenta
circObj.Lineweight = acLnWt020
'' ElseIf TypeOf holderObj Is AcadBlbla''<--etc...
End If
Next blkRef
'' clean up
oSset.Delete
Set oSset = Nothing
Set hndColl = Nothing
End Sub

'Sub test()
'Dim hndColl As New Collection
'Dim itm As Variant
'Dim ar() As Variant
'Dim i As Integer, j As Integer
'Dim filename As String
'filename = ThisDrawing.Path & "\" & Replace(ThisDrawing.Name, "dwg", "csv")
'If Dir(filename) = "" Then
'MsgBox ("File .csv not found. Run lisp before")
'Exit Sub
'End If
'Set hndColl = ReadTxtFile(filename)
'i = 0
'For Each itm In hndColl
'Debug.Print itm(0) & vbTab & itm(1)
'i = i + 1
'Next itm
'
'
'End Sub
[/vba]

here is AutoLisp code
[vba]
;; Open Notepad and save this code say as ALINKS.lsp
(vl-load-com)
;; helper functions
;;;(C)2005 Jason Piercey
; function to determine if a field
; has been applied to an object.
; Arguments:
; [object] - vla-object
; return: vla-object, IAcadObject or nil
; Notes:
; First stab at doing anything with fields
; unsure if this function will cover all
; instances that are possible.
(defun field-p (object / result)
(if
(and
(= :vlax-true (vla-get-hasextensiondictionary object))
(setq
result
(vl-catch-all-apply
(function
(lambda ()
(vla-item
(vla-getextensiondictionary object)
"Acad_field")))))
(not (vl-catch-all-error-p result)) )

(vla-item result 0)
)
)
; based on function above
; function to get handle
; Arguments:
; [handle of parent object] - string
; return: handle of object, linked by field , string or empty string
(defun getholder(handle / atobj doc elist field fieldobj flddict holder)
(setq doc
(vla-get-activedocument(vlax-get-acad-object)))
(setq atobj (vlax-ename->vla-object (handent handle)))
(setq flddict(vl-catch-all-apply
(function
(lambda ()
(vla-item
(vla-getextensiondictionary atobj)
"ACAD_FIELD")))))
(setq fieldobj (vl-catch-all-apply
(function
(lambda ()
(vla-item
flddict
"TEXT")))))
(setq field (vlax-vla-object->ename fieldobj))
(setq elist (entget field))
(setq holder (cdr (assoc 5 (entget (cdr (assoc 331(entget (cdr (assoc 360 elist)))))))))
holder
)
;;============================ main program =============================;;
(defun C:ALINKS (/ *error* attlist blkname blkobj datafile data_line en filename hdl sset tagname)
(defun *error* (msg)
(if datafile (close datafile))
(if msg (princ (strcat "\nError! " msg)))
(princ)
)

(setq filename (strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))".csv")
)
(setq blkname (getstring T "\nEnter block name: "))
(if (eq blkname "")(progn (exit)(princ)))
(setq tagname (strcase (getstring T "\nEnter attribute tag: ")))
(if (eq tagname "")(progn (exit)(princ)))
(command "._zoom" "_e")
(prompt "\n\tSelect desired blocks >> ")
(if
(setq sset (ssget "X"
(list
(cons 0 "INSERT")
(cons 2 blkname)
(cons 66 1)
(cons 410 (getvar "CTAB")))))

(progn
(setq datafile (open filename "W"))

(while (setq en (ssname sset 0))
(setq blkobj (vlax-ename->vla-object en))
(setq attlist (vlax-invoke blkobj 'getattributes))
(foreach attobj attlist
(if (and (eq (strcase (vla-get-tagstring attobj)) (strcase tagname))(field-p attobj))
(progn
(setq data_line (strcat (setq hdl(vla-get-handle attobj)) "," (getholder hdl)))
(write-line data_line datafile))))
(ssdel en sset)
)
(close datafile)
)
)
(command "._zoom" "_p")
(alert (strcat "Handle pairs was saved in file:\n" "\"" filename "\"\n( in the same folder )" ))
(princ)
)
(C:ALINKS)
(prompt "\nLisp code loaded...")
;;;(prompt "\nStart command with Alinks")
(prin1)
[/vba]

some troubles.

1) when I appload alinks.lsp, following the instructions i get this error:

Comand: appload
alinks.lsp loaded.
Comand:
Enter block name: Etichetta Locale
Enter attribute tag: CODICE_LOCALE
._zoom
Specificare un angolo della finestra, digitare un fattore di scala (nX o nXP) o
[Tutto/Centrato/Dinamico/Estensioni/Precedente/scAla/Finestra/Oggetto] <tempo
reale>: _e
Comand:
Select desired blocks >>
Error! no function definition: VLAX-ENAME->VLA-OBJECT

2) when i run vba code it seems it can't get Extension Dictionary for the attribute attObj.

I really hope this is not so difficult to solve. I attach my files if these could be of help.

Quote:

---

Originally Posted by ALe

some troubles.

1) when I appload alinks.lsp, following the instructions i get this error:

Comand: appload
alinks.lsp loaded.
Comand:
Enter block name: Etichetta Locale
Enter attribute tag: CODICE_LOCALE
._zoom
Specificare un angolo della finestra, digitare un fattore di scala (nX o nXP) o
[Tutto/Centrato/Dinamico/Estensioni/Precedente/scAla/Finestra/Oggetto] <tempo
reale>: _e
Comand:
Select desired blocks >>
Error! no function definition: VLAX-ENAME->VLA-OBJECT

2) when i run vba code it seems it can't get Extension Dictionary for the attribute attObj.

I really hope this is not so difficult to solve. I attach my files if these could be of help.

---

Hi Ale
First you did not copied lisp code completely
this line at the very top:
[vba](vl-load-com)[/vba]
is very important, it will be upload ActiveX dynamic libraries and its functions from AutoCAD program folder
Secondly, in your drawing I have not found a blocks 'Etichetta locale'
with attributes CODICE_LOCALE that has fields - every attribute just with
value of 'XXXX', by this reason the lisp command will be return just empty
CSV file
So add a line of code above, populate 1-2 block attribute with fields
and try again
Hey, this drawing is very familiar to me, buddy :)
Let me know the result after test

Quote:

---

Originally Posted by fixo

Hi Ale
First you did not copied lisp code completely
this line at the very top:
[vba](vl-load-com)[/vba]
is very important, it will be upload ActiveX dynamic libraries and its functions from AutoCAD program folder
Secondly, in your drawing I have not found a blocks 'Etichetta locale'
with attributes CODICE_LOCALE that has fields - every attribute just with
value of 'XXXX', by this reason the lisp command will be return just empty
CSV file
So add a line of code above, populate 1-2 block attribute with fields
and try again
Hey, this drawing is very familiar to me, buddy :)
Let me know the result after test

---

sorry for the first line. now lisp works.

Also VBA code seems to work!!!!

Yes the file! it is the only file I had to send you and to test because today i'm not in my office, so I downloaded from my previous post.

Of course you know it!
Thank you so much.

Next Monday I'll try to suit it to my needs.

Bye

Alright, I'll wating for result
of testing it on your working drawing
See you Monday

here test result: working perfectly!

I changed the lisp code in order to suit to my needs (the variables "Etichetta Locale" and "Area Stanza" are given by default).

the strange thing is that the original code works for this line
[VBA]
oSset.SelectOnScreen fType, fData
[/VBA]

but this update doesn't work
[VBA]
oSset.Select acSelectionSetAll, , , fType, fData
[/VBA]

and I don't understand why. But this is another issue...

Thank you Oleg.

Quote:

---

Originally Posted by ALe

here test result: working perfectly!

I changed the lisp code in order to suit to my needs (the variables "Etichetta Locale" and "Area Stanza" are given by default).

the strange thing is that the original code works for this line
[vba]
oSset.SelectOnScreen fType, fData
[/vba]

but this update doesn't work
[vba]
oSset.Select acSelectionSetAll, , , fType, fData
[/vba]

and I don't understand why. But this is another issue...

Thank you Oleg.

---

You're welcome :)

You have to zoom drawing to extents before selection,

and define selection mode explicitly,

Something like, i.e.:
[vba]

Dim oSset As AcadSelectionSet

Set oSset = ThisDrawing.SelectionSets.Add("$Plines$")

ZoomExtents

Dim mode As Integer

mode = acSelectionSetAll

Dim vt(0 To 2) As Integer

vt(0) = 0: vt(1) = 70: vt(2) = 410

Dim curTab As Variant

curTab = ThisDrawing.GetVariable("CTAB")

oSset.Select mode, , , vt, Array("LWPOLYLINE", 1, CStr(curTab))

MsgBox "Selected " & oSset.Count & " closed polylines"

oSset.Delete[/vba]

I did do ZoomExtents. this is original code (sound it familiar to you? :rofl: )
[VBA]
Dim fType(1) As Integer
Dim fData(1) As Variant

fType(0) = 0: fType(1) = 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
fData(0) = "INSERT": fData(1) = "Etichetta Locale" '' <-- change blockname here
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
For Each oSset In ThisDrawing.SelectionSets
If oSset.Name = "$Blocks$" Then
oSset.Delete
Exit For
End If
Next oSset
Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$") '' <-- any name is admissible
On Error GoTo 0

oSset.SelectOnScreen fType, fData
[/VBA]

I Added the following lines instead of the last original sentence
[VBA]
Application.ZoomExtents
oSset.Select acSelectionSetAll, , , fType, fData
[/VBA]

The selection gets the blocks but in such a way that is different from the original code...

Quote:

---

Originally Posted by ALe

I did do ZoomExtents. this is original code (sound it familiar to you? :rofl: )
[vba]
Dim fType(1) As Integer
Dim fData(1) As Variant

fType(0) = 0: fType(1) = 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
fData(0) = "INSERT": fData(1) = "Etichetta Locale" '' <-- change blockname here
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
For Each oSset In ThisDrawing.SelectionSets
If oSset.Name = "$Blocks$" Then
oSset.Delete
Exit For
End If
Next oSset
Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$") '' <-- any name is admissible
On Error GoTo 0

oSset.SelectOnScreen fType, fData
[/vba]

I Added the following lines instead of the last original sentence
[vba]
Application.ZoomExtents
oSset.Select acSelectionSetAll, , , fType, fData
[/vba]

The selection gets the blocks but in such a way that is different from the original code...

---

Try this quick example
Hope this will make a sense
[vba]
Sub Example_CompareSelectionModes()
Dim oSset As AcadSelectionSet
Dim fType(1) As Integer
Dim fData(1) As Variant
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Parcels$")
End With

fType(0) = 0: fType(1) = 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
fData(0) = "INSERT": fData(1) = "Etichetta Locale" '' <-- change blockname here
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
For Each oSset In ThisDrawing.SelectionSets
If oSset.Name = "$Blocks$" Then
oSset.Delete
Exit For
End If
Next oSset
Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$") '' <-- any name is admissible
On Error GoTo 0
'' 1st case: Select on screen is means selection in the current layout
'' so it is no needs to define selection filter with dxf code for current layout

oSset.SelectOnScreen fType, fData
MsgBox "First method: " & vbCr & "Selected on screen manually " & oSset.Count & " blocks" & vbCr & _
"[ that is means in the current LAYOUT ]"
'' using the same selection for the second method

oSset.Clear

'' 2nd case: Select all in the current layout
'' in this case you have to to define selection filter with dxf code for current layout

Application.ZoomExtents '<-- always use it before of selection without manual interaction

Dim mode As Integer

mode = acSelectionSetAll '<-- define mode explicitly

Dim curTab As Variant

curTab = ThisDrawing.GetVariable("CTAB")

Dim dxfType(2) As Integer
Dim dxfData(2) As Variant
dxfType(0) = 0: dxfType(1) = 2: dxfType(2) = 410 '<-- 410 is dxf code for layout name
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
dxfData(0) = "INSERT": dxfData(1) = "Etichetta Locale": dxfData(2) = CStr(curTab) '<-- dxf value for current layout name
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
oSset.Select mode, , , dxfType, dxfData
MsgBox "Second method: " & vbCr & "Selected using ""acSelectionSetAll"" mode " & oSset.Count & " blocks" & vbCr & _
"[ in the current LAYOUT ]"
'' using the same selection for the third method

oSset.Clear

'' 3nd case: Select all in the current drawing
'' no need to define selection filter with dxf code for current layout for you

Dim dxfTyp(1) As Integer
Dim dxfDat(1) As Variant
dxfTyp(0) = 0: dxfTyp(1) = 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
dxfDat(0) = "INSERT": dxfDat(1) = "Etichetta Locale"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
oSset.Select mode, , , dxfType, dxfData
MsgBox "Third method: " & vbCr & "Selected using ""acSelectionSetAll"" mode " & oSset.Count & " blocks" & vbCr & _
"[ in the current DRAWING ]"
End Sub[/vba]

thank you very much!

For each one of the case the number of blocks results the same.

Running all the code:
1st case works always.
2nd case works for some files, not for some others.
3rd case doesn't work.

I can't explain why this happens, but it's good for me to work using 1st case.

Thank you again for your wonderful help! :thumb

Quote:

---

Originally Posted by ALe

thank you very much!

For each one of the case the number of blocks results the same.

Running all the code:
1st case works always.
2nd case works for some files, not for some others.
3rd case doesn't work.

I can't explain why this happens, but it's good for me to work using 1st case.

Thank you again for your wonderful help! :thumb

---

Sorry, my bad the very last code must be like this:
[vba]
oSset.Select mode, , , dxfTyp, dxfDat
MsgBox "Third method: " & vbCr & "Selected using ""acSelectionSetAll"" mode " & oSset.Count & " blocks" & vbCr & _
"[ in the current DRAWING ]"

[/vba]

thank you, I had seen it and corrected it.

Bye!

You're welcome
Cheers :)

Download the free trial of AutoCAD Attribute Block and give that a try.

convertdgntodwg.net