Trouver txt dans fenêtre avec coordonnées

Bonjour à tous,

ayant déjà consulté bon nombre de post là, j'ai besoin de votre aide car je suis coincé.

Je dois récupérer des données provenant de autocad.

J'ai un bloc et juste à côté un text qui correspond à sa dénomination.

Malheureusement les 2 ne sont pas liés donc je ne peux pas faire un extract de données des 2 ensemble.

Actuellement, je fais un Data extraction du bloc pour obtenir son layer et ses coordonnées dans un fichier excel.

j'arrive à faire un cadre autrour du bloc sélectionné par une polyligne.

mais je n'arrive pas à trouver le moyen de récupérer le text qui se trouve près du bloc et ainsi de l'ajouter à mon fichier excel.

le fichier excel se compose comme ceci

en ligne 2, col 1 (endroit ou je désire mettre l'info du texte)

en ligne 2, col 2 (nom du bloc)

en ligne 2, col 3 (x)

en ligne 2, col 4 (y)

voici le début de mon code

Private Sub CommandButton1_Click()

Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel1 As Excel.Worksheet 'Feuille Excel
Dim wsExcel2 As Excel.Worksheet 'Feuille Excel
Dim PATH_EXCEL As String
Dim PATH_EXCEL1 As String
Dim PATH_EXCEL2 As String

Dim AP As String
Dim PHASE As String
Dim X As Variant
Dim Y As Variant
Dim X1 As Variant
Dim X2 As Variant
Dim Y1 As Variant
Dim Y2 As Variant
Dim Laycurrent As AcadLayer
Dim strLayer As String

Dim RECOBJ As AcadLWPolyline
Dim points(0 To 7) As Double
 

'Récupération des données dans excell
   
'OUVERTURE DU FICHIER EXCEL SOURCE
   
PATH_EXCEL = ("R:\TEST_AP.xls")

PATH_EXCEL1 = PATH_EXCEL & ("\")
   
   

'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True

'Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open(PATH_EXCEL)

'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)

Row = 2

If wsExcel.Cells(Row, 1) <> "0" Then

Do
'Récupération des données excel
AP = wsExcel.Cells(Row, 1)
PHASE = wsExcel.Cells(Row, 2)
X = wsExcel.Cells(Row, 3)
Y = wsExcel.Cells(Row, 4)

'Activation du layer
If PHASE = "AP_PHASE1" Then
strLayer = "AP PHASE 1"
ElseIf PHASE = "AP_PHASE2" Then
strLayer = "AP PHASE 2"
End If
Set Laycurrent = ThisDrawing.Layers.Item(strLayer)

ThisDrawing.ActiveLayer = Laycurrent

' Create a Ray object in model space
X1 = (X - 4000000) / 10000
X2 = (X + 4000000) / 10000

Y1 = (Y + 3000000) / 10000
Y2 = (Y - 3000000) / 10000

points(0) = X1: points(1) = Y1
points(2) = X1: points(3) = Y2
points(4) = X2: points(5) = Y2
points(6) = X2: points(7) = Y1
Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineobj.Closed = True

Merci à tous de m'aider.

Getolek

Image may be NSFW.
Clik here to view.Image may be NSFW.
Clik here to view.Image may be NSFW.
Clik here to view.Image may be NSFW.
Clik here to view.Image may be NSFW.
Clik here to view.

Image may be NSFW.
Clik here to view.