Option Explicit

'|   Function GetAllAttributes
'|   Description:
'|   Get all attributes data include constant.
'|   Copyright: all rights removed
'|   ©2006
'|   Author: Fatty The Old Horse
'|   Arguments:
'|     - blkRef = AcadBlockReference
'|   Return:
'|     - Two dimensional array with tags and values
'|   Notes:
'|     - None

Public Function GetAllAttributes(ByVal blkRef As AcadBlockReference) As Variant
Dim atRef As Object
Dim verArr, cstArr, tmpArr As Variant
Dim attArr As New Collection
Dim attData() As Variant
Dim i, j As Integer
On Error GoTo ErrCheck

    If blkRef.HasAttributes Then
      '|  Get "usual" attributes
      verArr = blkRef.GetAttributes
      If UBound(verArr) >= LBound(verArr) Then
      For i = LBound(verArr) To UBound(verArr)
      attArr.Add verArr(i)
      Next i
      End If
      '|  Get constant attributes
      cstArr = blkRef.GetConstantAttributes
      If UBound(cstArr) >= LBound(cstArr) Then
        For i = LBound(cstArr) To UBound(cstArr)
        attArr.Add cstArr(i)
        Next i
      End If
    End If

    i =  0 
    ReDim attData(attArr.Count -  1 ,  1 )
    For Each atRef In attArr
    attData(i,  0 ) = atRef.TagString
    attData(i,  1 ) = atRef.TextString
    i = i +  1 
    Next
ErrCheck:
MsgBox Err.Description
GetAllAttributes = attData
End Function

Sub ReadRoomLabels()
Dim varPt As Variant
Dim objEnt As AcadEntity

With ThisDrawing
.Utility.GetEntity objEnt, varPt, vbCr & "Select a room labelblock"
If Not TypeOf objEnt Is AcadBlockReference Then
MsgBox "Selected entity is not a block"
Exit Sub
Else
Dim objBlk As AcadBlockReference
Set objBlk = objEnt
Dim minExt As Variant
Dim maxExt As Variant
objBlk.GetBoundingBox minExt, maxExt
Dim dblDist As Double
dblDist = Abs(minExt( 0 ) - maxExt( 0 ))
'//MsgBox dblDist

Dim insPt As Variant
insPt = objBlk.InsertionPoint
Dim point1( 0  To  2 ) As Double
Dim point2( 0  To  2 ) As Double
point1( 0 ) = insPt( 0 ) - dblDist *  5 : point1( 1 ) = insPt( 1 ) - dblDist *  5 : point1( 2 ) =  0 
point2( 0 ) = insPt( 0 ) + dblDist *  5 : point2( 1 ) = insPt( 1 ) + dblDist *  5 : point2( 2 ) =  0 
ZoomWindow point1, point2
objBlk.Highlight (True)
Dim attvar As Variant
attvar = GetAllAttributes(objBlk)
Dim lblNum As String
Dim i As Integer
For i = LBound(attvar) To UBound(attvar)
If attvar(i,  0 ) = "ROOM_NO" Then
lblNum = attvar(i,  1 )
Exit For
End If
Next
End If


Dim fso, sh, s
Set sh = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

s = .Path & "\" & lblNum & ".txt"
          If fso.FileExists(s) = False Then
               MsgBox "No such file.",  16 , "Wrong File Name"
                Exit Sub
          End If
       sh.Run s

End With
End Sub