here is code to extract block attributes to actocad using vb.6..
but i need to code to extract the dimesions value or mtext without opening outocad..

add reference for autocad and excel



[vba]
Sub Extract()
Row = 2
col = 1

'Form1.Cls
Dim sheet As Object
Dim shapes As Object
Dim elem As Object
Dim excel As Object
Dim Max As Integer
Dim Min As Integer
Dim NoOfIndices As Integer
Dim excelSheet As Object
Dim RowNum As Integer
Dim Array1 As Variant
Dim Count As Integer
Dim Teller As Integer
Dim Teller1 As Integer
Dim str() As String
Screen.MousePointer = vbHourglass
For i = 0 To List2.ListCount - 1
Text6.Text = i
Text7.Text = List2.List(i)
procOpenDrawing
Set Doc = acad.ActiveDocument
Set mspace = Doc.ModelSpace
RowNum = 1
Dim Header As Boolean
Header = False
Teller = 0
Teller1 = 0
Text1.Text = ""

Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
'Text5.Text = ""
List1.Clear
For Each elem In mspace
With elem
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If .HasAttributes Then
Teller = Teller + 1
Array1 = .GetAttributes
' Text1.Text = Text1.Text & vbNewLine & " ****** Read the TAGS ***** " & vbNewLine
' For Count = LBound(Array1) To UBound(Array1)
' If Header = False Then
' If StrComp(Array1(Count).EntityName, "AcDbBlockReference", 1) = 0 Then
' Text1.Text = Text1.Text & Array1(Count).TagString & vbNewLine
' End If
' End If
' Debug.Print
' Next Count
RowNum = RowNum + 1

' Text1.Text = Text1.Text & vbNewLine & " ****** Read the VALUE ***** " & vbNewLine
str1 = ""
For Count = LBound(Array1) To UBound(Array1)
Teller1 = Teller1 + 1
str1 = Array1(Count).tagstring
If str1 = "Materiale" Or str1 = UCase("Materiale") Then
Text2.Text = Text2.Text & Array1(Count).textstring
ElseIf str1 = "BesKrivelse1" Or str1 = UCase("BesKrivelse1") Or _
str1 = "BesKrivelse2" Or str1 = UCase("BesKrivelse2") Or _
str1 = "BesKrivelse3" Or str1 = UCase("BesKrivelse3") Then

Text3.Text = Array1(Count).textstring

If Val(Text3.Text) Then
str = Split(Text3.Text, "x")
For intLoop1 = LBound(str) To UBound(str)
List1.AddItem (Val(str(intLoop1)))
Next intLoop1
End If
ElseIf str1 = "Tegningsnr" Or str1 = UCase("Tegningsnr") Then
Text4.Text = Array1(Count).textstring


ElseIf str1 = "Varenr" Or str1 = UCase("Varenr") Then
Text1.Text = Array1(Count).textstring
End If
Next Count
Debug.Print
Header = True
End If
End If
End With
Next elem



' myexcel.ActiveSheet.Cells(row, col).HorizontalAlignment = xlCenter
'myexcel.ActiveSheet.Cells(row, col).Font.Bold = True
'myexcel.Visible = True
myexcel.ActiveSheet.Cells(Row, col) = Text1.Text
myexcel.ActiveSheet.Cells(Row, col + 1) = Text2.Text
myexcel.ActiveSheet.Cells(Row, col + 3) = List1.List(0)
myexcel.ActiveSheet.Cells(Row, col + 4) = List1.List(1)
myexcel.ActiveSheet.Cells(Row, col + 5) = List1.List(2)
myexcel.ActiveSheet.Cells(Row, col + 6) = Text4.Text
Row = Row + 1
col = 1
Next i
NumberOfAttributes = RowNum - 1
If NumberOfAttributes > 0 Then

Else
MsgBox "No attributes found in the current drawing"
End If
Set acad = Nothing

' Me.SetFocus
Screen.MousePointer = vbNormal

End Sub
[/vba]
EDIT : Added VBA tags Tommy