Liaison autocad/excel et excel autocad pour mise à jour d\'attribut de bloc et valeur de paramètre

TiChan · le 3 mars 2011

Bonjour!

Besoin d'aide car je bloc!

Voici le problème à résoudre :

J'ai créé un bloc circulaire dynamique avec attributs et paramètres :

Attributs :

-Nom

-Numéro

Paramètres :

-Diamètre

Une fois avoir inséré le bloc au différents emplacements sur le dessin en ayant donné nom et numéro, je souhaite effectuer un export des données d'attributs et paramètres vers une feuille excel, pour ensuite pouvoir les mettre à jour directement depuis excel, et que cela se traduise graphiquement dans le dessin (le paramètre "diamètre").

Pour préciser d'avantage ma requête, j'ai trouvé ceci qui ne résout que la moitié du problème :

http://maxence.delannoy.pagesperso-orange.fr/vba/att_excel.htm

En fait, je recherche exactement la même chose avec en plus la possibilité d'extraire les paramètres, et de pouvoir les mettre à jour.

Merci pour votre aide.

TiChan · le 6 mars 2011

N'y aurai t il personne qui pourrai m'aider?

Avis aux pro du vba.

lili2006 · le 6 mars 2011

Bonjour à toutes et tous,

Et les fonctions des express tools ATTOUT et ATTIN ne pourrait-il pas faire l'affaire ?

Avis aux pro du vba.

Ce n'est pas une réponse en VBA et ce langage ayant tendance à disparaitre, je ne sais pas si tu vas avoir beaucoup de réponses allant dans ce sens,...

TiChan · le 6 mars 2011

Merci pour ton aide, je vais regarder dans ce sens et je tien au jus!

Je recherchai à améliorer le code vba du programme que j'avais trouvé sur le site de Maxence pour répondre à mon problème. Mais je suis ouvert à toute solution, là c'est le résultat qui compte.

TiChan · le 6 mars 2011

l'outil est interressant mais ne répond que partiellement à mes attentes...

En fait j'aimerai faire figurer dans l'export le paramètre "diamètre" que j'ai créé dans le bloc dynamique afin de pouvoir l'éditer depuis excel. Pour l'instant je n'arrive qu'a exporter des attributs avec les différentes méthodes et à les mettre à jour depuis excel.

[Edité le 6/3/2011 par TiChan]

rom1_am · le 7 mars 2011

Bonjour,

J'avais fait cette fonction pour lire/modifier des propriétés de blocs dynamiques:

 
Function F_PropDynBlocModifierLire(Bloc As AcadBlockReference, NomPropDyn As String, valeur As Variant, action As String) As Variant
'**********************************************************************
'Description: Fonction servant à modifier ou lire une propriété dynamique de bloc
'Parametres: -Bloc (objet), Nom de la propriété, valeur
'           - action: doit prendre la valeur "lire" ou "modifier"
'**********************************************************************
   Dim i As Integer 'le compteur des attributs d'un bloc
   Dim varPropDyn As Variant 'la collection des propriétés dynamique d'un bloc
   
   On Error Resume Next 'au cas où la valeur en parametre ne soit pas du bon type
   If Bloc.IsDynamicBlock Then
       varPropDyn = Bloc.GetDynamicBlockProperties
       For i = LBound(varPropDyn) To UBound(varPropDyn)
         If varPropDyn(i).PropertyName = NomPropDyn Then
             If action = "modifier" Then  'mettre à jour la prop. dyn
                 If valeur = Empty Then valeur = ""
                 varPropDyn(i).Value = valeur
                 Exit For
             ElseIf action = "lire" Then  'lire la prop. dyn
                 F_PropDynBlocModifierLire = varPropDyn(i).Value
                 Exit For
             End If
         End If
       Next i
   End If
End Function

Je pense qu'en l'adaptant et en la rajoutant dans l'exemple que tu as trouvé, ça devrait faire l'affaire.

A+

TiChan · le 9 mars 2011

Merci beaucoup!

Si j'y arrive ça serait énorme! je tiens au jus.

TiChan · le 9 mars 2011

Bonsoir,

Après avoir galérer toute la soirée (je n'ai pas de compétences) j'ai essayé de modifier le code de Maxence qui permet de remplir un tableau excel avec des attributs, mais pour avoir les propriétés des blocs dynamiques du dessin AutoCAD.

Voici comment j'ai adapté la partie du code : (ça ne marche pas)

J'ai essayer de faire ce que je pouvais avec la fonction mais comme je n'ai aucunes connaissances ni compétences en programmation, c'est chaud pour moi.

Comment faire pour que cela marche?

Voici un également un lien vers le bloc dynamique dont je souhaite pouvoir modifier les propriétés via excel :

https://www.yousendit.com/download/eURCd0VLeFhQb0pjR0E9PQ

Public Sub ExtraireAttributs()

Dim AcadApp As AutoCAD.AcadApplication

Dim SelSet As AutoCAD.AcadSelectionSet

Dim FilterType(0) As Integer

Dim FilterData(0) As Variant

Dim FiltersType, FiltersData As Variant

Dim i, Row, j, Column As Integer

Dim Entity As AcadEntity

Dim Blocref As AcadBlockReference

Dim varPropDyn As Variant

Dim ColumnExist As Boolean

' Efface toutes les données contenues dans la feuille

Range("1:65536").ClearContents

' On demande le nom du fichier à ouvrir

Dim Filename As Variant

Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")

If Filename = False Then

Exit Sub

End If

Cells(1, 1).Value = Filename

' 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

' 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, Cells(1, 1).Text, vbTextCompare) = 0 Then

Dwg.Activate

Opened = True

End If

AcadApp.Documents.Open (Cells(1, 1).Text)

End If

' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel)

Application.Visible = True

' Remplissage de l'entête du tableau

Cells(3, 1).Value = "Nom du bloc"

Cells(3, 2).Value = "Handle"

Row = 4 ' 1ère ligne du tableau

' On crée un jeu de sélection ou on le récupère si il existe déjà

On Error Resume Next

Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")

If Err <> 0 Then

Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET")

SelSet.Clear

End If

' On prépare un filtre de sélection sur les insertions de bloc

FilterType(0) = 0

FilterData(0) = "INSERT"

FiltersType = FilterType

FiltersData = FilterData

' Sélection des entités

SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData

' On balaye le jeu de sélection

For i = 0 To SelSet.Count - 1

Set Entity = SelSet.Item(i)

' Si l'objet est une insertion de bloc

If Entity.ObjectName = "AcDbBlockReference" Then

' On précise le type de l'objet pour pouvoir accéder à ses propriétés et

' ses méthodes spécifiques

Set Blocref = Entity

' Si il a des attributs

If Blocref.HasAttributes Then

Cells(Row, 1).Value = Blocref.Name

Cells(Row, 2).Value = "'" & Blocref.Handle

' On les récupére

varPropDyn = Bloc.GetDynamicBlockProperties

' On parcourt le tableau

For j = LBound(varPropDyn) To UBound(varPropDyn)

' On recherche si une colonne existe déjà pour cette étiquette d'attribut

Column = 3

ColumnExist = False

While Not IsEmpty(Cells(3, Column))

If Cells(3, Column).Text = varPropDyn(j).PropertyName Then

' Une colonne existe, on la remplit avec la valeur de l'atribut

Cells(Row, Column).Value = varPropDyn(j).Value

ColumnExist = True

End If

Column = Column + 1 ' On passe à la colonne suivante

Wend

If Not ColumnExist Then

' Aucune colonne n'existe, on en crée une et on la remplit

Cells(3, Column).Value = varPropDyn(j).TagString

Cells(Row, Column).Value = varPropDyn(j).TextString

End If

Next ' Attribut suivant

Row = Row + 1 ' Ligne suivante

End If

End Sub

[Edité le 9/3/2011 par TiChan]

rom1_am · le 11 mars 2011

Bonjour,

Essaie de remplacer:

'BlocRef.HasAttributes' par 'BlocRef.IsDynamicBlock'

Sinon, essaie de nous donner plus de détails sur l'endroit exact qui fait que ça plante.

Bon courage

TiChan · le 11 mars 2011

Bonjour, je viens d'essayer, et je n'y arrive toujours pas. En fait si j'arrive à modifier cette partie du code de Maxence, cela me permettrai de comprendre comment ça marche, et de pouvoir ensuite éditer l'ensemble.

Lorsque je lance la macro, celle-ci ne se bloque pas, mais n'affiche pas le résultat escompté. Seuls les noms des blocs et Handle sont récupérés.

Pour faire simple je joint ci-dessous une image d'explication de ce que je cherche à faire :

https://www.yousendit.com/dl?phi_action=app/orchestrateDownload&rurl=https%253A%252F%252Fwww.yousendit.com%252Ftransfer.php%253Faction%253Dbatch_download%2526batch_id%253DeURBdFdUb0JreER2Wmc9PQ

Vraiment merci pour ton aide, car je sent que je suis proche du but.

[Edité le 12/3/2011 par TiChan]

rom1_am · le 14 mars 2011

Bonjour,

Ton code ci-dessus ne fonctionne pas car tu as remplacé 'TextString' et 'TagString' par 'Propertyname' et 'Value' uniquement dans la 1ere partie du code qui remplit les colonnes si elles existent déjà et pas dans la 2eme partie qui ajoute les noms de colonnes si elles n'ont pas été trouvées.

PS: si tu veux à la fois les attributs et les propriétés dynamiques, il te suffit de dupliquer le paragraphe qui récupère et écrit les attributs dans Excel et de le modifier pour récupérer les propriétés dynamqiues.

En gros, repars du fichier d'origine que tu as trouvé, et rajoute le code suivant entre les lignes

 Next ' Attribut suivant

et

 Row = Row + 1 ' Ligne suivante

:

       ' PROP DYN
       Attributes = BlocRef.GetDynamicBlockProperties
       
       ' On parcourt le tableau
       For j = LBound(Attributes) To UBound(Attributes)
         ' On recherche si une colonne existe déjà pour cette étiquette d'attribut
         Column = 3
         ColumnExist = False
         While Not IsEmpty(Cells(3, Column))
           If Cells(3, Column).Text = Attributes(j).PropertyName Then
             ' Une colonne existe, on la remplit avec la valeur de l'atribut
             Cells(Row, Column).Value = Attributes(j).Value
             ColumnExist = True
           End If
           Column = Column + 1 ' On passe à la colonne suivante
         Wend
         
         If Not ColumnExist Then
           ' Aucune colonne n'existe, on en crée une et on la remplit
           Cells(3, Column).Value = Attributes(j).PropertyName
           Cells(Row, Column).Value = Attributes(j).Value
         End If
         
       Next ' Propriété dyn suivante

TiChan · le 16 mars 2011

Bonjour,

Ca marche! merci mille fois.

Ainsi j'arrive à récupérer à la fois les attributs des blocs, puis les propriétés dynamiques de ceux-ci.

J'ai cependant un dernier souci à régler :

Selon le même principe, je suis en train de tenter de modifier la partie du code qui me permettra de mettre à jour ces données dans autocad. Mais la macro se bloque et j'ai un message d'erreur.

Erreur d’exécution 'xxxxxxxx'

Entrée incorrecte

Le débogueur me surligne la ligne :

Attributes(i).Value = Cells(Row, Column).Value

Voici l'ensemble du code que j'essaye de modifier :

Dim DrawingFile As String

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
       
               ' PROPDYN
       Attributes = BlocRef.GetDynamicBlockProperties
       
       ' 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).PropertyName Then
             Attributes(i).Value = Cells(Row, Column).Value
           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 ne comprend pas pourquoi ça ne marche pas. Merci encore pour ton aide.

rom1_am · le 17 mars 2011

Bonjour,

Ok tant mieux si ça marche.

Pour modifier les propriétés dynamiques en général, il faut bien faire attention aux données que tu cherches à écrire: il faut que la valeur soit du bon type et qu'elle ne soit pas en dehors des plages de valeur possible dans ta propriété dynamique.

Essaie d'utiliser l'espion vba pour voir le type de valeur qui est pris par la propriété dynamique que tu veux modifier.

Ou alors, modifie ton bloc manuellement et exécute ta fonction qui récupère les données sous Excel pour voir la valeur que tu cherches à obtenir.

Par sécurité, il vaut mieux rajouter un 'On error resume next' avant le paragraphe où tu modifies les propriétés dynamiques (comme dans l'exemple de la fonction F_PropDynBlocModifierLire que j'ai mis au début de ce post.)

a+

TiChan · le 6 avril 2011

Bonsoir,

Je me permet de revenir pour essayer d'aller au bout de cette démarche.

Après de multiples essais et bidouilles, je n'ai toujours pas réussi à enclencher la mise à jour des propriétés récupérées dans le tableau excel vers autocad.

Ce qui est interressant dans cette macro, c'est le fait de pouvoir mettre à jour les propriétés graphiques d'un ensemble de bloc (par exemple le diamètre de la couronne d'un arbre, de son tronc, et sa symbologie (feuillu ou conifère)) d'un seul coup depuis excel.

Dans le cas où je n'y arrive pas, un grand merci à toi Rom1_am pour ton aide précieuse depuis le début.

RhymOne · le 6 avril 2011

Bonjour j'interviens dans la discussion pour indiquer un nom a noter qui est (gile) auprès de qui tu pourrais un mp,

Cette personne je pense t'indiquera la bonne marche a suivre pour réaliser le sens inverse Exel vers autocad !

D'ailleurs je vais m'empresser de tester ce que tu a deja fait peux tu faire un envoie zip du fichier vba ?

A noter en lisant le faleu gile que le vba a un Risque de longévité sur les produits autodesk , en gros en 201x ton progr est bon pour la benne !! ( a verifiier )

A plus

rom1_am · le 7 avril 2011

Salut,

Les liens vers les fichiers que tu avais mis sont expirés.

Pourrais-tu poster ton fichier excel avec la macro que tu as commencé à modifier ainsi que ton fichier AutoCAD que tu cherches à lire/modifier?

A+

PS: il est vrai que le vba est à l'abandon, mais il est toujours dans la version 2012 et toujours dans Excel donc si ce petit bout de programme peut te servir 2-3 ans, c'est toujours ça de pris. De plus, il y a pas mal de similitudes entre le vba et le vb.net, donc des petites routines de ce genre seront relativement faciles à adapter le moment venu (en espérant que d'ici là, les outils pour développer en .net pour AutoCAD auront été simplifiés car pour l'instant, c'est tout de même un peu galère de se plonger là-dedans, surtout pour faire des petits bouts de programme de quelques dizaines de lignes de code.)

(Ce n'est que mon avis)

[Edité le 7/4/2011 par rom1_am]

TiChan · le 12 avril 2011

Bonsoir,

Voici un lien vers une archive qui contient le fichier autocad (un bloc "Arbre" dynamique qui me sert pour des relevés de végétation et des plans) et le fichier xls avec la macro que je cherche à modifier. J'y ai mis également les éléments de base à partir desquels je suis parti (Merci à Maxence).

En prévision de l'abandon du vba, il y aura t-il d'autre possibilité qui permettront ce type de communication entre logiciels différents? lisp ou autre?

https://www.yousendit.com/download/UFhzZUNrNXYrV3hjR0E9PQ

Salutations!

rom1_am · le 13 avril 2011

Salut,

Rajoute

On Error Resume Next

juste après :

  ' PROPDYN
       Attributes = BlocRef.GetDynamicBlockProperties

(Ligne 72 dans la fonction EnvoyerVersAutoCAD)

Ce qui pose problème est la propriété dynamique 'Origin' qui attend un tableau de valeur.

Avec le 'On Error Resume Next' ça fonctionne, sinon, pour faire plus propre, tu pourrais rajouter un test pour ne pas prendre en compte cette propriété.

Aide-toi de l'espion pour voir le contenu de la variable 'Attributes' pour voir les valeurs prises réellement par tes différentes propriétés.

a+

TiChan · le 16 avril 2011

Salut!

Et voila c'est magnifique! Un grand merci pour ton aide et pour le temps consacré.

Voici l'ensemble du code pour ceux que cela pourrai intéresser :

Dim DrawingFile As String

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
       
               ' PROPDYN
       Attributes = BlocRef.GetDynamicBlockProperties

       On Error Resume Next
       
       ' 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).PropertyName Then
             Attributes(i).Value = Cells(Row, Column).Value
           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

Public Sub ExtraireAttributs()
 Dim AcadApp As AutoCAD.AcadApplication
 Dim SelSet As AutoCAD.AcadSelectionSet
 Dim FilterType(0) As Integer
 Dim FilterData(0) As Variant
 Dim FiltersType, FiltersData As Variant
 
 Dim i, Row, j, Column As Integer
 Dim Entity As AcadEntity
 Dim BlocRef As AcadBlockReference
 Dim Attributes As Variant
 Dim ColumnExist As Boolean
 
 ' Efface toutes les données contenues dans la feuille
 Range("1:65536").ClearContents
 
 ' On demande le nom du fichier à ouvrir
 Dim Filename As Variant
 Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")
 If Filename = False Then
   Exit Sub
 End If
 Cells(1, 1).Value = Filename
 
 ' 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
 
 ' 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, Cells(1, 1).Text, vbTextCompare) = 0 Then
      Dwg.Activate
      Opened = True
   End If
 Next
 
 If Not Opened Then
   AcadApp.Documents.Open (Cells(1, 1).Text)
 End If
 
 ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel)
 Application.Visible = True
 
 ' Remplissage de l'entête du tableau
 Cells(3, 1).Value = "Nom du bloc"
 Cells(3, 2).Value = "Handle"
 
 Row = 4 ' 1ère ligne du tableau
 
 ' On crée un jeu de sélection ou on le récupère si il existe déjà
 On Error Resume Next
 Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")
 If Err <> 0 Then
   Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET")
   SelSet.Clear
 End If
 
 ' On prépare un filtre de sélection sur les insertions de bloc
 FilterType(0) = 0
 FilterData(0) = "INSERT"
 FiltersType = FilterType
 FiltersData = FilterData
 
 ' Sélection des entités
 SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData
 
 ' On balaye le jeu de sélection
 For i = 0 To SelSet.Count - 1
   Set Entity = SelSet.Item(i)
   
   ' Si l'objet est une insertion de bloc
   If Entity.ObjectName = "AcDbBlockReference" Then
     ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et
     ' ses méthodes spécifiques
     Set BlocRef = Entity
     
     ' Si il a des attributs
     If BlocRef.HasAttributes Then
       Cells(Row, 1).Value = BlocRef.Name
       Cells(Row, 2).Value = "'" & BlocRef.Handle
       
       ' On les récupére
       Attributes = BlocRef.GetAttributes
       
       ' On parcourt le tableau
       For j = LBound(Attributes) To UBound(Attributes)
         ' On recherche si une colonne existe déjà pour cette étiquette d'attribut
         Column = 3
         ColumnExist = False
         While Not IsEmpty(Cells(3, Column))
           If Cells(3, Column).Text = Attributes(j).TagString Then
             ' Une colonne existe, on la remplit avec la valeur de l'atribut
             Cells(Row, Column).Value = Attributes(j).TextString
             ColumnExist = True
           End If
           Column = Column + 1 ' On passe à la colonne suivante
         Wend
         
         If Not ColumnExist Then
           ' Aucune colonne n'existe, on en crée une et on la remplit
           Cells(3, Column).Value = Attributes(j).TagString
           Cells(Row, Column).Value = Attributes(j).TextString
         End If
         
       Next ' Attribut suivant
       
        ' PROP DYN

       Attributes = BlocRef.GetDynamicBlockProperties

       

       ' On parcourt le tableau

       For j = LBound(Attributes) To UBound(Attributes)

         ' On recherche si une colonne existe déjà pour cette étiquette d'attribut

         Column = 3

         ColumnExist = False

         While Not IsEmpty(Cells(3, Column))

           If Cells(3, Column).Text = Attributes(j).PropertyName Then

             ' Une colonne existe, on la remplit avec la valeur de l'atribut

             Cells(Row, Column).Value = Attributes(j).Value

             ColumnExist = True

           End If

           Column = Column + 1 ' On passe à la colonne suivante

         Wend

         

         If Not ColumnExist Then

           ' Aucune colonne n'existe, on en crée une et on la remplit

           Cells(3, Column).Value = Attributes(j).PropertyName

           Cells(Row, Column).Value = Attributes(j).Value

         End If

         

       Next ' Propriété dyn suivante
       
       Row = Row + 1 ' Ligne suivante
     End If
   End If
 Next
 
 MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès."
End Sub

Merci à Maxence et merci Rom1_am.

A bientot sur les forum.

VtKp · le 15 mai 2011

Bonjour à tous,

Généralement habitué au lisp, j'aimerais faire marcher cette macro [surligneur] depuis Excel[/surligneur] mais le code plante à la ligne

 Sub EnvoyerVersAutoCAD()
[surligneur]   Dim AcadApp As AutoCAD.AcadApplication[/surligneur]

Merci de me confirmer l'utilisation de ce code,

A partir de Vba Excel, il s'agit d'extraire les attributs d'un dessin Autocad

Non il faut bien copier-coller le code ci-dessus dans un vba Excel et non dans un vba Autocad

De plus, ne faut-il pas avoir des Dll d'installer ou autre pour permettre la communication d'Excel à Autocad ? Ce qui expliquerai peut être l'erreur de compilation

Ou sinon merci de m'indiquer la procédure pour pouvoir utiliser ce code depuis Excel avec un fichier Autocad ouvert.

Merci par avance de votre aide.

VtKp · le 15 mai 2011

Dans Outils, References, j'ai coché toutes les dll relatives à Autocad.

Désormais je n'ai plus le problème précédent mais le code vba excel plante à la ligne surligné dont je remets le code pour être sur qu'on parle bien de la même chose

Private Sub CommandButton1_Click()

 Dim AcadApp As AutoCAD.AcadApplication
 Dim SelSet As AutoCAD.AcadSelectionSet
 Dim FilterType(0) As Integer
 Dim FilterData(0) As Variant
 Dim FiltersType, FiltersData As Variant
 
 Dim i, Row, j, Column As Integer
 Dim Entity As AcadEntity
 Dim BlocRef As AcadBlockReference
 Dim Attributes As Variant
 Dim ColumnExist As Boolean
 
 ' Efface toutes les données contenues dans la feuille
 Range("1:65536").ClearContents
 
 ' On demande le nom du fichier à ouvrir
 Dim Filename As Variant
 Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")
 If Filename = False Then
   Exit Sub
 End If
 Cells(1, 1).Value = Filename
 
 ' 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
 
 ' 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, Cells(1, 1).Text, vbTextCompare) = 0 Then
      Dwg.Activate
      Opened = True
   End If
 Next
 
 If Not Opened Then
   [surligneur]  AutoCAD App.Documents.Open(Cells(1, 1).Text)[/surligneur] 
End If
 
 ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel)
 Application.Visible = True
 
 ' Remplissage de l'entête du tableau
 Cells(3, 1).Value = "Nom du bloc"
 Cells(3, 2).Value = "Handle"
 
 Row = 4 ' 1ère ligne du tableau
 
 ' On crée un jeu de sélection ou on le récupère si il existe déjà
 On Error Resume Next
 Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")
 If Err <> 0 Then
   Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET")
   SelSet.Clear
 End If
 
 ' On prépare un filtre de sélection sur les insertions de bloc
 FilterType(0) = 0
 FilterData(0) = "INSERT"
 FiltersType = FilterType
 FiltersData = FilterData
 
 ' Sélection des entités
 SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData
 
 ' On balaye le jeu de sélection
 For i = 0 To SelSet.Count - 1
   Set Entity = SelSet.Item(i)
   
   ' Si l'objet est une insertion de bloc
   If Entity.ObjectName = "AcDbBlockReference" Then
     ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et
     ' ses méthodes spécifiques
     Set BlocRef = Entity
     
     ' Si il a des attributs
     If BlocRef.HasAttributes Then
       Cells(Row, 1).Value = BlocRef.Name
       Cells(Row, 2).Value = "'" & BlocRef.Handle
       
       ' On les récupére
       Attributes = BlocRef.GetAttributes
       
       ' On parcourt le tableau
       For j = LBound(Attributes) To UBound(Attributes)
         ' On recherche si une colonne existe déjà pour cette étiquette d'attribut
         Column = 3
         ColumnExist = False
         While Not IsEmpty(Cells(3, Column))
           If Cells(3, Column).Text = Attributes(j).TagString Then
             ' Une colonne existe, on la remplit avec la valeur de l'atribut
             Cells(Row, Column).Value = Attributes(j).TextString
             ColumnExist = True
           End If
           Column = Column + 1 ' On passe à la colonne suivante
         Wend
         
         If Not ColumnExist Then
           ' Aucune colonne n'existe, on en crée une et on la remplit
           Cells(3, Column).Value = Attributes(j).TagString
           Cells(Row, Column).Value = Attributes(j).TextString
         End If
         
       Next ' Attribut suivant
       
        ' PROP DYN

       Attributes = BlocRef.GetDynamicBlockProperties
       
       ' On parcourt le tableau

       For j = LBound(Attributes) To UBound(Attributes)

         ' On recherche si une colonne existe déjà pour cette étiquette d'attribut

         Column = 3

         ColumnExist = False

         While Not IsEmpty(Cells(3, Column))

           If Cells(3, Column).Text = Attributes(j).PropertyName Then

             ' Une colonne existe, on la remplit avec la valeur de l'atribut

             Cells(Row, Column).Value = Attributes(j).Value

             ColumnExist = True

           End If

           Column = Column + 1 ' On passe à la colonne suivante

         Wend

         

         If Not ColumnExist Then

           ' Aucune colonne n'existe, on en crée une et on la remplit

           Cells(3, Column).Value = Attributes(j).PropertyName

           Cells(Row, Column).Value = Attributes(j).Value

         End If

         

       Next ' Propriété dyn suivante
       
       Row = Row + 1 ' Ligne suivante
     End If
   End If
 Next
 
 MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès."
End Sub

Et en elevant cette ligne, le code fonctionne très bien

Pourquoi ? Je veux quand même le faire ce contrôle avec le IF open ?

Merci par avance de votre aide

rom1_am · le 17 mai 2011

Bonjour,

Sur la ligne que tu as surlignée, ce n'est pas plutôt "AcadApp" à la place de "AutoCAD App" ?

a+

VtKp · le 20 mai 2011

Bonjour

Desole pour cette reponse tardive Mais en effete c'était ça le problem

Merci encore

le 24 mai 2011

Je suis sur un problème semblable (sans excel néanmoins). D'après ce que j'ai compris : La méthode HasAttributes fonctionne en utilisant TagString et TextString (pour modifier les attributs), et pour ce qui est de modifier les attributs dynamiques (GetDynamicBlockProperties), il faut utiliser les fonctions PropertyName et Value.

Le problème est que la fonction Value ne fonctionne pas (run time error Entrée incorrecte), j'accède bien à la valeur de l'attribut dynamique (un MsgBox fonctionne) mais je n'arrive pas à le mettre à jour. (Un Attributes(i).Value = "" donne la même erreur)

rom1_am · le 25 mai 2011

Bonjour,

Ok tant mieux si ça marche.

Pour modifier les propriétés dynamiques en général, il faut bien faire attention aux données que tu cherches à écrire: il faut que la valeur soit du bon type et qu'elle ne soit pas en dehors des plages de valeur possible dans ta propriété dynamique.

Essaie d'utiliser l'espion vba pour voir le type de valeur qui est pris par la propriété dynamique que tu veux modifier.
Ou alors, modifie ton bloc manuellement et exécute ta fonction qui récupère les données sous Excel pour voir la valeur que tu cherches à obtenir.

Par sécurité, il vaut mieux rajouter un 'On error resume next' avant le paragraphe où tu modifies les propriétés dynamiques (comme dans l'exemple de la fonction F_PropDynBlocModifierLire que j'ai mis au début de ce post.)

a+

Bonjour,

A mon avis, c'est le problème que ci-dessus, il faut bien faire attention à la valeur que tu cherches à écrire.

Utilises l'espion vba pour voir les vraies valeurs mémorisées dans les propriétés dynamiques.

A+

Connexion

Liaison autocad/excel et excel autocad pour mise à jour d\'attribut de bloc et valeur de paramètre

Messages recommandés

TiChan

TiChan

lili2006

TiChan

TiChan

rom1_am

TiChan

TiChan

rom1_am

TiChan

rom1_am

TiChan

rom1_am

TiChan

RhymOne

rom1_am

TiChan

rom1_am

TiChan

VtKp

VtKp

rom1_am

VtKp

Invité Clampu

rom1_am

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante