Bonjour
Ci apres une petite macro VBA qui traînait dans mes tiroirs et que j'ai
adaptée pour toi.
Elle se lance depuis Excel.
Copier le code dans un module VBA d'un fichier Excel.
S'assurer que dans l'éditeur Visual Basic, Options/Référence, la
bibliothèque d'objet d'Autocad soit bien cochée.
Ensuite lancer la macro, celle ci te demandera le fichier à traiter par la
boite de dialogue standard, et tu récupérera dans Excel les renseignements
demandés et plus.
Bon courage
C.L.
Public Sub Extraire_Blocs()
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 Point As Variant
Dim i, Ligne, 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")
' On crée la ligne de titre
Cells(3, 1).Value = "Nom du bloc"
Cells(3, 2).Value = "X"
Cells(3, 3).Value = "Y"
Cells(3, 4).Value = "Z"
Cells(3, 5).Value = "Echelle X"
Cells(3, 6).Value = "Echelle Y"
Cells(3, 7).Value = "Echelle Z"
Cells(3, 8).Value = "Rotation"
Cells(3, 9).Value = "Calque"
' On ouvre le fichier dans AutoCAD
AcadApp.Documents.Open (Cells(1, 1).Text)
Ligne = 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
Cells(Ligne, 1) = BlocRef.Name
Point = BlocRef.InsertionPoint
Cells(Ligne, 2) = Point(0)
Cells(Ligne, 3) = Point(1)
Cells(Ligne, 4) = Point(2)
Cells(Ligne, 5) = BlocRef.XScaleFactor
Cells(Ligne, 6) = BlocRef.YScaleFactor
Cells(Ligne, 7) = BlocRef.ZScaleFactor
Cells(Ligne,
😎 = BlocRef.Rotation
Cells(Ligne, 9) = BlocRef.Layer
Ligne = Ligne + 1
End If
Next
' On ferme AutoCAD
AcadApp.Quit
Reponse = MsgBox("Les blocs du dessin " & Cells(1, 1).Text & " ont été
extraits avec succès.", 64, "Message de C.lecossier")
End Sub
"Michel a"
a écrit dans le message de
news:40b425cd_3@newsprd01...
> Bonjour à tous
>
> je me suis toujours débrouillé comme j'ai pu pour essayer d'integrer des
> attributs à des blocs sans, pour que je puisse les extraires, etc.., je
> reçois souvent des plans avec des blocs sans attributs, je recherche une
> routine pour les extraires tout simplement.
>
> PS: j'ai déjà essayé d'ajouter des attributs, attredef, mais ma méthode
> d'extraction ne les reconnait pas.
>
> je vous remercie d'avance de votre aide
>
> Michel a
>
>
