VBA autocad Excel

Bonjour

Merci ça marche

J'ai un autre souci cependant:
J'ai plein de bloc
mais je voudrai récupéré que les attributs de deux blocs qui se noment
Nomenclature et HA_Nomenclature
Nomenclature comporte commorte comme Attributs TYPE, TYPE1, REP, NB_HA
HA_Nomenclature te commorte comme Attributs TYPE1, NB_HA

Mon est que ça me marque une erreur est ça me souligne cette ligne

"ExcelSheet.Cells(i, colonne) = Attributes(j).TextString"

et la je bloque. Si tu sais ce qui ce passe merci

Bonjour,
Je crois que ça vient de la valeur de colonne. Si colonne=0 alors ça plante.
En plus tu ne filtre pas les blocs. Tu devrais traiter les blocs dans des feuilles séparées.

voila ce que je mettrais pour filtrer le bloc Nomenclature

If Objet.EntityType = 7 And Objet.Nane =  "Nomenclature" Then
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
   Case "TYPE": colonne = 1
   Case "TYPE1": colonne = 2
   Case "REP": colonne = 3
   Case "NB_HA": colonne = 4
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
Next j
 i = i + 1 'on passe à la ligne suivante pour le prochain
End If

Merci
je n'ai pas encore essayé, je te tiens au courant. par contre pour mon cas je ne vois pas d'intérer de faire une feuille pour chaque attributs. alors si je me trompe pas il faudrait que je fasse un select case comme si dessous pour les blocs et les attributs que je veux.

If Objet.EntityType = 7 Then
select case Objet.Nane
case"Nomenclature
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
Case "TYPE": colonne = 1
Case "TYPE1": colonne = 2
Case "REP": colonne = 3
Case "NB_HA": colonne = 4
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
Next j
i = i + 1 'on passe à la ligne suivante pour le prochain
End If
Case"HA_Nomenclature
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
Case "TYPE1": colonne = 1
Case "NB_HA": colonne = 2
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
Next j
i = i + 1 'on passe à la ligne suivante pour le prochain
End If

JP

Bonjour,

J'ai déja réalisé ce programme avec Autolisp, donc par expérience je sais qu'il faut traiter les blocs individuellement. Voila comment je procède:
- je demande à l'utilisateur de sélectionner (à l'ecran) le bloc à traiter
- je recupère le nom du bloc , je verifie qu'il a des attributs et j'ecris sur la 1ère ligne les etiquettes (tags)
- je demande à faire une selection d'objets (capture , tout, ...)
- dans la selection, j'extrais les attributs de tous les blocs qui correspondent au bloc choisi et j'ecris leurs valeurs sur la 2ème ligne et les suivantes.

C'est l'algorithme de base. Tu peut traiter tous les blocs d'un coup mais en les triants et en utilisant une feuille excel différente pour chaque série.

;)

Bonjour

le programma marche a merveille un grand merci, j'ai fait comme tu m'as dit, une feuille pour chaque attribut. cependant j'ai un dernier souci, je récupère bien que les attributs du bloc dont j'ai renseigné le nom (ici Nomenclature) par contre je récupère le "Handles" de tout les blocs alors que je ne veux que ceux des Blocs Nomenclature

.'Programmation Visual BASIC dans AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Excel.Worksheet, ExcelWorkBook As Excel.Workbooks
Private Sub Liste_Click()
Dim Collection As Object, Objet As Object
Dim i As Integer
Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer

'ExcelApp est un lien sur l'application excel en cours
On Error Resume Next
'Verifie si Excel est ouvert et sinon l'ouvrir.
Set objExcel = GetObject(, "Excel.Application")
If Err.Number > 0 Then
Set objExcel = CreateObject("Excel.Application")
End If
objExcel.Visible = True

Set ExcelWorkBook = objExcel.Workbooks.Open("f:\Projet LP CAODAO\Projet 2.0\EXCEL\TESTE.xls")
Set ExcelSheet = objExcel.ActiveWorkbook.Sheets("Extraction")

'AcadDoc est un lien sur le dessin en cours
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument

'Remplissage sur la ligne n°1 de le feuille Feuil1 des entêtes de colonnes
ExcelSheet.Cells(1, 1) = "ID"
ExcelSheet.Cells(1, 2) = "TYPE"
ExcelSheet.Cells(1, 3) = "TYPE1"
ExcelSheet.Cells(1, 4) = "NBRE_ELEMENT"
ExcelSheet.Cells(1, 5) = "REP"
ExcelSheet.Cells(1, 6) = "NB_HA"
ExcelSheet.Cells(1, 7) = "DIAM_HA"
ExcelSheet.Cells(1, 8) = "LONG_HA"
ExcelSheet.Cells(1, 9) = "E_HA"

'collection représente l'ensemble des entités graphiques contenues dans l'espace objet
Set Collection = AcadDoc.ModelSpace
i = 2
'Pour chaque objet de la collection

For Each Objet In Collection
'Remplissage dans excel, ligne par ligne à partir de la deuxième
'ligne de la feuille, en indiquant l'identifiant, le type d'entité
If Objet.Nane = "Nomenclature" Then
ExcelSheet.Cells(i, 1) = Objet.GetAttributes.Handle
If Objet.EntityType = 7 Then
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
Case "TYPE": colonne = 2
Case "TYPE1": colonne = 3
Case "NBRE_ELEMENT": colonne = 4
Case "REP": colonne = 5
Case "NB_HA": colonne = 6
Case "DIAM_HA": colonne = 7
Case "LONG_HA": colonne = 8
Case "E_HA": colonne = 9
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
Next j
i = i + 1 'on passe à la ligne suivante pour le prochain
End If
End If
Next

End Sub


Merci