xvplayer

Je comprend pas ce que tu veux dire ? je connais pas trop vos régles si je t'es hirité je suis désolé.

salut, g commencé a faire un code vba pour les cartouches sur plusieur fichiers, sa marche mais pour le rendre plus convial g besoin d'aide.Et désolé pour les imperfections Ya 3 partie une macro pour extraire sur les attribut sur excel selon une mise en forme bien déterminé Une autre pour choisir les fichier a traiter et l'autre pour remplir les attribus selon ce qu'on a marqué sur excel sur chaque fichier a traiter maintenant le probléme c que je commence a programer et c un peu fouilli et pas convivial. sa donne ça: Dim DrawingFile As String Sub OuvreFichier() Dim QuelFichier As Variant QuelFichier = Application.GetOpenFilename("Fichiers AutoCAD,*.dwg", , , , True) For Ctr = 1 To UBound(QuelFichier) Cells(1, Ctr) = QuelFichier(Ctr) Next End Sub Sub EnvoyerVersAutoCAD() Dim AcadApp As AutoCAD.AcadApplication Dim BlocRef As AcadBlockReference Dim Row, i, Column, f, a, b As Integer Dim SelSet As AutoCAD.AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim FiltersType, FiltersData As Variant Dim Entity As AcadEntity Dim Attributes As Variant Dim ColumnExist As Boolean ' On lance AutoCAD Set AcadApp = New AutoCAD.AcadApplication AcadApp.Visible = True c = 1 While Not IsEmpty(Cells(1, c)) ' On s'arrête quand on tombe sur une cellule fichier vide 'For c = 1 To 100 ' On ouvre le fichier dans AutoCAD AcadApp.Documents.Open (Cells(1, c).Text) ' 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 For b = 0 To SelSet.Count - 1 Set Entity = SelSet.Item(b) ' 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 le bloc a des attributs... 'If BlocRef.HasAttributes Then ' ... on les récupère Attributes = BlocRef.GetAttributes Row = 4 ' On commence à la rangée N°4 ' On parcourt le tableau For a = 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(a).TagString Then Attributes(a).TextString = Cells(Row, Column).Text End If Column = Column + 1 ' On passe à la colonne suivante Wend Next BlocRef.Update End If Next c = c + 1 ' On passe au fichier suivant Wend ' 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 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 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 bon d'accord g pompé sur internet pas mal de choses mais bon le temps passé est consécant ! surtout pour un débutant. Par contre Je maitrise pas les controles et je shouterai renplacer dans Sub ExtraireAttributs() selectionner le bloc sur le fichier référence Merci d'avance et je suis preneur d'idée pour améliorer.