VBA AutoCAD Excel

Hello

Thank you, it works

I have another problem though:
I have lots of blocks
but I only want to retrieve the attributes of two blocks named
Nomenclature and HA_Nomenclature
Nomenclature has attributes TYPE, TYPE1, REP, NB_HA
HA_Nomenclature has attributes TYPE1, NB_HA

My issue is that it shows me an error and it highlights this line

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

and I'm stuck. If you know what’s going on, thank you.

Hello,
I believe it's due to the column value. If column=0 then it crashes.
Also, you are not filtering the blocks. You should process the blocks in separate sheets.

Here’s what I would use to filter the Nomenclature block

If Objet.EntityType = 7 And Objet.Name = "Nomenclature" Then Attributes = Objet.GetAttributes For j = 0 To UBound(Attributes) Select Case Attributes(j).TagString Case "TYPE": column = 1 Case "TYPE1": column = 2 Case "REP": column = 3 Case "NB_HA": column = 4 End Select ExcelSheet.Cells(i, column) = Attributes(j).TextString Next j i = i + 1 'move to the next line for the next End If

Thank you
I haven't tried it yet, I'll keep you posted. However, for my case, I don't see the point of making a sheet for each attribute. So if I'm not mistaken, I should make a select case like below for the blocks and attributes I want.

If Objet.EntityType = 7 Then
select case Objet.Name
case "Nomenclature"
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
Case "TYPE": column = 1
Case "TYPE1": column = 2
Case "REP": column = 3
Case "NB_HA": column = 4
End Select
ExcelSheet.Cells(i, column) = Attributes(j).TextString
Next j
i = i + 1 'move to the next line for the next one
End If
Case "HA_Nomenclature"
Attributes = Objet.GetAttributes
For j = 0 To UBound(Attributes)
Select Case Attributes(j).TagString
Case "TYPE1": column = 1
Case "NB_HA": column = 2
End Select
ExcelSheet.Cells(i, column) = Attributes(j).TextString
Next j
i = i + 1 'move to the next line for the next one
End If

JP

Hello,

I have already done this program with Autolisp, so from experience, I know that it is necessary to handle the blocks individually. Here’s how I proceed:
- I ask the user to select (on the screen) the block to be processed
- I retrieve the name of the block, check that it has attributes, and write the tags on the first line
- I ask to make a selection of objects (capture, all, ...)
- in the selection, I extract the attributes of all the blocks that correspond to the chosen block and write their values on the second line and the following lines.

This is the basic algorithm. You can process all the blocks at once but by sorting them and using a different Excel sheet for each series.

;)

Hello

the program works wonderfully, thank you very much. I did as you told me, one sheet for each attribute. However, I have one last issue; I retrieve the attributes of the block for which I specified the name (here Nomenclature), but I get the "Handles" of all blocks whereas I only want those of Nomenclature blocks.

.'Visual BASIC Programming in 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 is a link to the current excel application
On Error Resume Next
'Check if Excel is open, and if not, open it.
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 is a link to the current drawing
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument

'Filling line 1 in the Feuil1 sheet with column headers
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 represents all graphical entities contained in the object space
Set Collection = AcadDoc.ModelSpace
i = 2
'For each object in the collection

For Each Objet In Collection
'Filling in excel, row by row starting from the second
'row of the sheet, indicating the identifier, the type of entity
If Objet.Name = "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 'move to the next line for the next
End If
End If
Next

End Sub


Thank you