VBA autocad Excel
JP
-
JP -
JP -
Bonjour,
voila je vous explique mon problème faire du VBA avec des if ou des select case j y arrive car rien de bien compliqué mais n'ayant jamais eu de formation de VBA la je bloc completement. On ma passé une formule qui me permet de récupérer sur Autocad les donnée des attributs dans les blocs sur Excel.
Mon problème est le suivant si je n'ouvre pas excel ça ne marche pas.
Ce que j'aimerai c'est que lorsque j'exécute ce programme mon fichier Excel qui s'appel "ESSAI.xls" s'ouvre. voici son chemin : "C:\Users\msi\Documents\ESSAI.xls"
voici le programme :
'Programmation Visual BASIC dans AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Object
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
'AcadDoc est un lien sur le dessin en cours
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument
'ExcelApp est un lien sur l'application excel en cours
Set ExcelApp = GetObject(, "Excel.application")
' je pense que c'est vers là qu'il faut que je renseigne
'le chemin de mon fichier Excel, mais je ne sais pas comment
'ExcelSheet est un lien sur la feuille de calcul nommée Feuil1
Set ExcelSheet = ExcelApp.activeworkbook.sheets("Feuil2")
'Remplissage sur la ligne n°1 de le feuille Feuil1 des entêtes de colonnes
ExcelSheet.Cells(1, 1) = "ID"
ExcelSheet.Cells(1, 2) = "POIDS_HA"
ExcelSheet.Cells(1, 3) = "POIDS_TS"
ExcelSheet.Cells(1, 4) = "TYPE"
'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é
'Ligne, Arc, Cercle ...etc
ExcelSheet.Cells(i, 4) = Objet.Handle
If Objet.EntityType = 7 Then
Attributes = Objet.GetAttributes
For j = LBound(Attributes) To UBound(Attributes)
Select Case Attributes(j).TagString
Case "POIDS_HA": colonne = 1
Case "POIDS_TS": colonne = 2
Case "TYPE": colonne = 3
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
'Attributes = Objet.GetAttributes(j)
i = i + 1
Next j
End If
Next
End Sub
Si quelqu'un pourrai me venir en aide. Merci d'avance
JP
voila je vous explique mon problème faire du VBA avec des if ou des select case j y arrive car rien de bien compliqué mais n'ayant jamais eu de formation de VBA la je bloc completement. On ma passé une formule qui me permet de récupérer sur Autocad les donnée des attributs dans les blocs sur Excel.
Mon problème est le suivant si je n'ouvre pas excel ça ne marche pas.
Ce que j'aimerai c'est que lorsque j'exécute ce programme mon fichier Excel qui s'appel "ESSAI.xls" s'ouvre. voici son chemin : "C:\Users\msi\Documents\ESSAI.xls"
voici le programme :
'Programmation Visual BASIC dans AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Object
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
'AcadDoc est un lien sur le dessin en cours
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument
'ExcelApp est un lien sur l'application excel en cours
Set ExcelApp = GetObject(, "Excel.application")
' je pense que c'est vers là qu'il faut que je renseigne
'le chemin de mon fichier Excel, mais je ne sais pas comment
'ExcelSheet est un lien sur la feuille de calcul nommée Feuil1
Set ExcelSheet = ExcelApp.activeworkbook.sheets("Feuil2")
'Remplissage sur la ligne n°1 de le feuille Feuil1 des entêtes de colonnes
ExcelSheet.Cells(1, 1) = "ID"
ExcelSheet.Cells(1, 2) = "POIDS_HA"
ExcelSheet.Cells(1, 3) = "POIDS_TS"
ExcelSheet.Cells(1, 4) = "TYPE"
'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é
'Ligne, Arc, Cercle ...etc
ExcelSheet.Cells(i, 4) = Objet.Handle
If Objet.EntityType = 7 Then
Attributes = Objet.GetAttributes
For j = LBound(Attributes) To UBound(Attributes)
Select Case Attributes(j).TagString
Case "POIDS_HA": colonne = 1
Case "POIDS_TS": colonne = 2
Case "TYPE": colonne = 3
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
'Attributes = Objet.GetAttributes(j)
i = i + 1
Next j
End If
Next
End Sub
Si quelqu'un pourrai me venir en aide. Merci d'avance
JP
1 réponse
-
Bonjour,
Dans VBA Editor, menu Outils Références verifier que Microsoft Excel 11.0 Object Library est bien coché
Voici ton code avec quelques modifs.
'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("C:\Users\msi\Documents\ESSAI.xls") Set ExcelSheet = objExcel.ActiveWorkbook.Sheets("Feuil2") '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) = "POIDS_HA" ExcelSheet.Cells(1, 3) = "POIDS_TS" ExcelSheet.Cells(1, 4) = "TYPE" '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é 'Ligne, Arc, Cercle ...etc ExcelSheet.Cells(i, 4) = Objet.Handle If Objet.EntityType = 7 Then Attributes = Objet.GetAttributes For j = LBound(Attributes) To UBound(Attributes) Select Case Attributes(j).TagString Case "POIDS_HA": colonne = 1 Case "POIDS_TS": colonne = 2 Case "TYPE": colonne = 3 End Select ExcelSheet.Cells(i, colonne) = Attributes(j).TextString 'Attributes = Objet.GetAttributes(j) i = i + 1 Next j End If Next End Sub-
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
-
