EXCEL VBA pour extraire les données des objets d'un dessin de AUTOCADMAP

[SEPPT]

 Bonjour,
je pilote AUTOCAD MAP depuis EXCEL, je sais déjà faire plein de manipulation, mais je n'arrive pas à récupérer les données objets des polylignes de mon dessin, pour les mettre dans un onglet de EXCEL, voici le début de mon code, est-ce que quelqu'un pourrait m'aider:

Merci pour votre aide

Sub INFO()
 
Dim ORD As ODRecord
Dim BlocRef As AcadBlockReference
Dim poly As AcadLWPolyline
Dim ligne As AcadLine
 
On Error Resume Next
 
 
        Set AcadObj = GetObject(, "AutoCAD.Application")
        If Err.Number <> 0 Then
            Set AcadObj = CreateObject("AutoCAD.Application")
            NombreDessinAutocad = -1
        Else
            acadDoc.Close
        End If
 
        Excel.Application.Visible = True
 
    Fichier = Application.GetOpenFilename("Autocad files (*.dwg), *.dwg")
 
    If Fichier <> "" Then
 
        AcadObj.Visible = True
        'maximiser la fenêtre autocad
        AcadObj.WindowState = 3
 
        Set acadDoc = AcadObj.Documents.Open(Fichier)
 
    End If
 
    ' selection des éléments du dessin
 
    If acadDoc.SelectionSets.Count < 1 Then
        Set sset = acadDoc.SelectionSets.Add("jeu")
    Else
        Set sset = acadDoc.SelectionSets.Item(0)
    End If
    If sset.Count < 1 Then                    ' si la zone de sélection  contient des objets
        Set toto = acadDoc.ModelSpace
    Else                                                               ' sinon prend tout le dessin
        Set toto = sset
    End If
 
    For Each AcadObj In toto
 
 
        With AcadObj
        If .EntityName = "AcDbBlockReference" Then
                Set BLOK = AcadObj
                    kk = 1
            Else
                If .EntityName = "AcDbPolyline" Then
                    Set poly = AcadObj
                    Set ORD = poly.GetODRecords
 
                    kk = 1
                Else
                    If .EntityName = "AcDbLine" Then
                        Set ligne = AcadObj
                        kk = 1
                    End If
                End If
            End If
        End With
   Next
 
End Sub

[norman.yuan]

I do not know French and use Google translate to see your question.

When you ask help, you'd better describe what issue you have run into with your code. Does it run at all, or it brings error at some point? 

I'd guess the code is not runable, or at least it would not run through. As matter of fact, if you click menu in VBA editor (Excel's VBA) "Debug->Compile VBA Project...", you likely get error.

Here are somethings regarding your code, see my comments in your code (in blue)

---

@SEPPT wrote:

...

Sub INFO()
 
Dim ORD As ODRecord
Dim BlocRef As AcadBlockReference
Dim poly As AcadLWPolyline
Dim ligne As AcadLine
 
On Error Resume Next
 
 
        Set AcadObj = GetObject(, "AutoCAD.Application")
        If Err.Number <> 0 Then
            Set AcadObj = CreateObject("AutoCAD.Application")
            NombreDessinAutocad = -1
        Else
            acadDoc.Close
        End If
        
        '' You run your code from Excel, it should have been already visible
        Excel.Application.Visible = True
 
    Fichier = Application.GetOpenFilename("Autocad files (*.dwg), *.dwg")
 
    If Fichier <> "" Then
 
        AcadObj.Visible = True
        'maximiser la fenêtre autocad
        AcadObj.WindowState = 3
 
        Set acadDoc = AcadObj.Documents.Open(Fichier)
 
    End If
 
    ' selection des éléments du dessin
 
    '' Since your code just open the drawing, there is no existing SelectionSet fpr sure
    '' No need to test if there is one
    If acadDoc.SelectionSets.Count < 1 Then
        Set sset = acadDoc.SelectionSets.Add("jeu")
    Else
        Set sset = acadDoc.SelectionSets.Item(0)
    End If

    '' The code creates a SelectionSet, and never selects anything
    '' So, why create a SelectionSet?
    If sset.Count < 1 Then                    ' si la zone de sélection  contient des objets
        '' What toto is? It cannot be either AcadModelSpace, or AcadSelectionSet
        '' unless it is decleared as "Object"
        Set toto = acadDoc.ModelSpace
    Else                                                               ' sinon prend tout le dessin
        Set toto = sset
    End If
 
    For Each AcadObj In toto
 
 
        With AcadObj
        If .EntityName = "AcDbBlockReference" Then
                Set BLOK = AcadObj
                    kk = 1
            Else
                If .EntityName = "AcDbPolyline" Then
                    Set poly = AcadObj
                    '' There line of code will not pass Compiling
                    '' An AcadObject/AcadLWPoline DOES NOT have a method called "GetODRecords()"
                    Set ORD = poly.GetODRecords
 
                    kk = 1
                Else
                    If .EntityName = "AcDbLine" Then
                        Set ligne = AcadObj
                        kk = 1
                    End If
                End If
            End If
        End With
   Next
 
End Sub

In order to access Objec Data, you need to set reference to AcMapVbApi.tlb, then you need to instantiate an AcadMap object, and then use ODTables or ODTable object to retrieve object data attached to AcadEntity.

You probably need to learn moreon how to use AcadMap COM API. 

Also, if you run your code from Excel VBA and your drawing has a lots of polyline having object data attached, the code execution might be very slow. In this case, it woul dbe better to do the object data retrieving work from AutoCAD VBA side and save retrieved data back to Excel sheet.

[SEPPT]

So, i don't understand everything that you mean... but thank you to answered me.

My pb is to select all entity and for each have the Object data attached to this acadentity and after printing  in a excel sheet....