Remplir des attributs d'Autocad via Excel
JP
-
JP -
JP -
Bonjour,
Je vous expose mon petit problème
Je doit renseigner des attributs par des données qui ce trouve sur Excel.
J'ai récupéré la programmation qui se trouve si dessous sur Internet, elle marche impacable. Mais je voudrais lui apporté une légère modification.
Dans mon fichier Excel sur ma feuille nommé "Accueil" j'ai créé un bouton lui affactant la macro si dessous.
Mais les donnée que ce programme doit chercher ce trouve sur ma feuille "Résultat"
J'ai du mal à savoir ou je doit renseigné dans ce programme la variable[Sheets("Résultat")]
Merci de m'aider
JP
Sub EnvoyerVersAutoCAD()
Dim AcadApp As AutoCAD.AcadApplication
Dim BlocRef As AcadBlockReference
Dim Row, i, Column As Integer
' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution)
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
If AcadApp Is Nothing Then
Set AcadApp = New AutoCAD.AcadApplication
End If
AcadApp.Visible = True
' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur
Dim Filename As String
If InStr(Cells(1, 1).Text, "\") <> 0 Then
Filename = Cells(1, 1).Text
Else
Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text
End If
' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert
Dim Opened As Boolean
Opened = False
Dim Dwg As AcadDocument
For Each Dwg In AcadApp.Documents
If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then
Dwg.Activate
Opened = True
End If
Next
If Not Opened Then
AcadApp.Documents.Open (Filename)
End If
Row = 4 ' On commence à la ligne N°4
Dim Handle As String
While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide
' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la
' méthode HandleToObject de l'objet document AutoCAD
Handle = Cells(Row, 2)
Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle)
' Si le bloc a des attributs...
If BlocRef.HasAttributes Then
' ... on les récupère
Attributes = BlocRef.GetAttributes
' On parcourt le tableau
For i = LBound(Attributes) To UBound(Attributes)
' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette
' de l'attribut
Column = 3
While Not IsEmpty(Cells(3, Column))
If Cells(3, Column).Text = Attributes(i).TagString Then
Attributes(i).TextString = Cells(Row, Column).Text
End If
Column = Column + 1 ' On passe à la colonne suivante
Wend
Next
BlocRef.Update
End If
Row = Row + 1 ' On passe à la ligne suivante
Wend
MsgBox "Les données ont été transférées vers AutoCAD avec succès."
End Sub
Je vous expose mon petit problème
Je doit renseigner des attributs par des données qui ce trouve sur Excel.
J'ai récupéré la programmation qui se trouve si dessous sur Internet, elle marche impacable. Mais je voudrais lui apporté une légère modification.
Dans mon fichier Excel sur ma feuille nommé "Accueil" j'ai créé un bouton lui affactant la macro si dessous.
Mais les donnée que ce programme doit chercher ce trouve sur ma feuille "Résultat"
J'ai du mal à savoir ou je doit renseigné dans ce programme la variable[Sheets("Résultat")]
Merci de m'aider
JP
Sub EnvoyerVersAutoCAD()
Dim AcadApp As AutoCAD.AcadApplication
Dim BlocRef As AcadBlockReference
Dim Row, i, Column As Integer
' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution)
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
If AcadApp Is Nothing Then
Set AcadApp = New AutoCAD.AcadApplication
End If
AcadApp.Visible = True
' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur
Dim Filename As String
If InStr(Cells(1, 1).Text, "\") <> 0 Then
Filename = Cells(1, 1).Text
Else
Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text
End If
' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert
Dim Opened As Boolean
Opened = False
Dim Dwg As AcadDocument
For Each Dwg In AcadApp.Documents
If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then
Dwg.Activate
Opened = True
End If
Next
If Not Opened Then
AcadApp.Documents.Open (Filename)
End If
Row = 4 ' On commence à la ligne N°4
Dim Handle As String
While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide
' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la
' méthode HandleToObject de l'objet document AutoCAD
Handle = Cells(Row, 2)
Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle)
' Si le bloc a des attributs...
If BlocRef.HasAttributes Then
' ... on les récupère
Attributes = BlocRef.GetAttributes
' On parcourt le tableau
For i = LBound(Attributes) To UBound(Attributes)
' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette
' de l'attribut
Column = 3
While Not IsEmpty(Cells(3, Column))
If Cells(3, Column).Text = Attributes(i).TagString Then
Attributes(i).TextString = Cells(Row, Column).Text
End If
Column = Column + 1 ' On passe à la colonne suivante
Wend
Next
BlocRef.Update
End If
Row = Row + 1 ' On passe à la ligne suivante
Wend
MsgBox "Les données ont été transférées vers AutoCAD avec succès."
End Sub
A voir également:
- Importer attribut excel vers autocad
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Ancienne version autocad gratuite - Télécharger - CAO-DAO
- Importer favoris chrome - Guide
- Si ou excel - Guide
1 réponse
Bonjour,
Moi je changerai l'ordre des instructions:
- récurération du nom du DWG (A1 de la feuille Accueil)
- activation de la feuille Résultat
- ouverture du DWG
- transfert des données
Sub EnvoyerVersAutoCAD()
Dim AcadApp As AutoCAD.AcadApplication
Dim BlocRef As AcadBlockReference
Dim Row, i, Column As Integer
' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur
Dim Filename As String
If InStr(Cells(1, 1).Text, "\") <> 0 Then
Filename = Cells(1, 1).Text
Else
Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text
End If
' Selectionner la feuille Résultats
ThisWorkbook.Sheets("Résultat").Select
' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution)
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
If AcadApp Is Nothing Then
Set AcadApp = New AutoCAD.AcadApplication
End If
AcadApp.Visible = True
' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert
Dim Opened As Boolean
Opened = False
Dim Dwg As AcadDocument
For Each Dwg In AcadApp.Documents
If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then
Dwg.Activate
Opened = True
End If
Next
If Not Opened Then
AcadApp.Documents.Open (Filename)
End If
'reste du code
Moi je changerai l'ordre des instructions:
- récurération du nom du DWG (A1 de la feuille Accueil)
- activation de la feuille Résultat
- ouverture du DWG
- transfert des données
Sub EnvoyerVersAutoCAD()
Dim AcadApp As AutoCAD.AcadApplication
Dim BlocRef As AcadBlockReference
Dim Row, i, Column As Integer
' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur
Dim Filename As String
If InStr(Cells(1, 1).Text, "\") <> 0 Then
Filename = Cells(1, 1).Text
Else
Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text
End If
' Selectionner la feuille Résultats
ThisWorkbook.Sheets("Résultat").Select
' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution)
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
If AcadApp Is Nothing Then
Set AcadApp = New AutoCAD.AcadApplication
End If
AcadApp.Visible = True
' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert
Dim Opened As Boolean
Opened = False
Dim Dwg As AcadDocument
For Each Dwg In AcadApp.Documents
If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then
Dwg.Activate
Opened = True
End If
Next
If Not Opened Then
AcadApp.Documents.Open (Filename)
End If
'reste du code
Je n'ai pas encore eu le temps d'essayer
Mais je te tiens au courant
Merci encore
JP
Merci
Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle)
Je ne voie pas prk ça ne marche pas
dans mon fichier Excel d'essai du programme ça marché, mais dans celui ou j'ai voulu mettre le programme ça ne marche pas
que je dois sélectionné qui est :AcObjClassImp1.0TypLibrary
Mais quant je veux la sélectionner ça me dit erreur de chargement de la DLL
que dois-je faire?
Merci
je regarde dans ma doc
A+