Probléme Excel Autocad

[vincent32050]

Bonjour j’ai un petit soucis avec le programme qui permet d’extraire des blocs avec leur attribut sur une feuille excel et avec l’autre programme qui permet d’envoyer des informations vers autocad.

J’ai définit les library suivante dans excel :

- Visual Basic For Applications

- Microsoft Excel 11.0 Object Library

- OLE Automation

- Microsoft Office 11.0 Object Library

- AutoCAD 2009 Type Library

 

Et j’ai l’erreur suivante dans le premier programme (envoyerVersAutocad) :

 

Erreur d’exécution ‘-2145386484(8020000c)’

Identificateur inconnu

 

Avec un arret sur la ligne que j’ai mis en rouge

 

Et l’erreur de l’autre programme (ExtraireAttributs) :

 

Erreur d’exécution ‘424’

Objet requis

 

Avec un arret sur la ligne que j’ai mis en rouge

 

 

 

Merci de votre aide je ne vois pas de solution !

 

 Dim DrawingFile As String

Sub EnvoyerVersAutoCAD()

 Dim AcadApp As AutoCAD.AcadApplication
 Dim BlocRef As AcadBlockReference
 Dim Row, i, Column As Integer
 
 ' On lance AutoCAD
 Set AcadApp = New AutoCAD.AcadApplication
 AcadApp.Visible = True

 ' On ouvre le fichier dans AutoCAD
 AcadApp.Documents.Open (Cells(1, 1).Text)
 
 Row = 4  ' On commence à la rangée N°4
 
 While Not IsEmpty(Cells(Row, 8)) ' 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
    [surligneur] Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Cells(Row, 1))[/surligneur]
   
   ' 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 = 8
         While Not IsEmpty(Cells(2, Column))
           If Cells(2, 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
 
 'AcadApp.ActiveDocument.Regen(acActiveViewport)
 
 ' On ferme AutoCAD
 AcadApp.Quit
 
 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 lance AutoCAD
 Set AcadApp = New AutoCAD.AcadApplication
 
 ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel)
 Application.Visible = True
 
 ' On demande le nom du fichier à ouvrir
 Cells(1, 1).Value = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")
 
 ' Remplissage de l'entête du tableau
 Cells(3, 1).Value = "Nom du bloc"
 Cells(3, 2).Value = "Handle"
 
 ' On ouvre le fichier dans AutoCAD
 AcadApp.Documents.Open (Cells(1, 1).Text)
 
 Row = 4 ' 1ère ligne du tableau
 
 ' On crée un jeu de sélection
 Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")
 
 ' 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
 
[surligneur]   For i = 0 To ThisDrawing.ModelSpace.Count - 1
   Set Entity = ThisDrawing.ModelSpace.Item(i)[/surligneur]

   
   ' 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
       
       Row = Row + 1 ' Ligne suivante
     End If
   End If
 Next
 
 ' On ferme AutoCAD
 AcadApp.Quit
 
 MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès."
End Sub