1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
| Sub RechercherReferenceAutoCAD()
Dim acadApp As Object
Dim acadDoc As Object
Dim textObj As Object
Dim refRecherche As String
Dim dossier As String
refRecherche = "VP 7010" ' À remplacer par votre référence
dossier = "C:\Chemin\Vers\Votre\Fichier.dwg" ' Chemin du fichier AutoCAD
' Ouvrir AutoCAD
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If acadApp Is Nothing Then
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True
End If
On Error GoTo 0
' Ouvrir le fichier AutoCAD
Set acadDoc = acadApp.Documents.Open(dossier)
' Parcourir tous les objets du modèle
Dim found As Boolean
found = False
For Each textObj In acadDoc.ModelSpace
' Vérifier si l'objet est du texte
If textObj.ObjectName = "AcDbText" Or textObj.ObjectName = "AcDbMText" Then
' Comparer le contenu du texte avec la référence
If InStr(1, textObj.TextString, refRecherche, vbTextCompare) > 0 Then
MsgBox "Référence trouvée : " & refRecherche
found = True
Exit For
End If
End If
Next textObj
' Fermer le fichier si la référence n'est pas trouvée
If Not found Then
MsgBox "Référence non trouvée dans le fichier " & dossier
End If
' Fermer le fichier AutoCAD
acadDoc.Close False
Set acadDoc = Nothing
Set acadApp = Nothing
End Sub |
Partager