Métré autocad vers excel

Salut
je travaille sur un plan dans Autocad 2008 et je trouve le calcul de métré fastidieux.
Donc je cherche une procédure d'extraction de données de autocad vers excel.
en effet j'ai besoin par exemple qu'il me renseigne sur la longueur des tuyauteries.
j'ai essayé d'utiliser la commande Extraction de données dans Outils mais je me rend compte qu'il me renseigne sur tout le dessin or que moi je voudrais lui spécifier le calque en question.
je veux juste travailler sur un calque mais pas sur l'ensemble du dessin.
Si quelqu'un a un astuce , partageons là alors .
TOP A VOS CLAVIERS......................

tout cela reste possible a partir de la 2009 -2010 ou la tu peux spécifié le calque etc

il faut inserer ta tuiyauterie sous forme de bloc la l extraxction va marche

Une petite macro VBA pour autocad :

Renseigne sur différent objets de base mais pas d'extraction des données de blocs
ça fait un moment que je m'en sert, c'est un peu brut comme résultat mais ça permet ensuite une grande souplesse sur excel (tri...)


Sub MOP()
Dim xlApp As Object
On Error GoTo fin
Set xlApp = GetObject(, "Excel.Application")
Dim strRep As String
Dim strTest As String
Dim i As Long
Dim Haut As Double
Dim PNum As Integer
Dim oObj As AcadObject
Dim oLay As AcadObject
Dim sLay As String
Dim ssObj As AcadSelectionSet
Dim sType As String
Dim sValue As String
Dim pBase As Variant
Dim oTmp As Acad3DSolid

With xlApp.ActiveSheet
.Cells(2, 1) = "N°"
.Cells(2, 2) = "Layer"
.Cells(2, 3) = "color"
.Cells(2, 4) = "Handle"
.Cells(2, 5) = "ObjectName"
.Cells(2, 6) = "x0"
.Cells(2, 7) = "y0"
.Cells(2, 8) = "z0"
.Cells(2, 9) = "Length/Volume"
.Cells(2, 10) = "Area/Rayon"
PNum = 3
On Error Resume Next
For Each oObj In ThisDrawing.ModelSpace
sLay = oObj.Layer
Set oLay = ThisDrawing.Layers(sLay)
If (Not oLay.Freeze) And (Not oLay.Lock) Then
.Cells(PNum, 1) = PNum
.Cells(PNum, 2) = oObj.Layer
.Cells(PNum, 3) = oObj.color
.Cells(PNum, 4) = "_" & oObj.Handle
.Cells(PNum, 5) = oObj.ObjectName
If oObj.ObjectName = "AcDbPolyline" Then
.Cells(PNum, 6) = oObj.Coordinate(0)(0)
.Cells(PNum, 7) = oObj.Coordinate(0)(1)
.Cells(PNum, 8) = oObj.Coordinate(0)(2)
.Cells(PNum, 9) = oObj.Length
.Cells(PNum, 10) = oObj.Area
End If
If oObj.ObjectName = "AcDbLine" Then
pBase = oObj.StartPoint
.Cells(PNum, 6) = pBase(0)
.Cells(PNum, 7) = pBase(1)
.Cells(PNum, 8) = pBase(2)
.Cells(PNum, 9) = oObj.Length
.Cells(PNum, 10) = ""
End If
If oObj.ObjectName = "AcDbCircle" Then
pBase = oObj.Center
.Cells(PNum, 6) = pBase(0)
.Cells(PNum, 7) = pBase(1)
.Cells(PNum, 8) = pBase(2)
.Cells(PNum, 9) = oObj.Circumference
.Cells(PNum, 10) = oObj.Radius
End If
If oObj.ObjectName = "AcDbArc" Then
pBase = oObj.Center
.Cells(PNum, 6) = pBase(0)
.Cells(PNum, 7) = pBase(1)
.Cells(PNum, 8) = pBase(2)
.Cells(PNum, 9) = oObj.ArcLength
.Cells(PNum, 10) = oObj.Radius
End If
If oObj.ObjectName = "AcDb3dSolid" Then
pBase = oObj.Position
.Cells(PNum, 6) = pBase(0)
.Cells(PNum, 7) = pBase(1)
.Cells(PNum, 8) = pBase(2)
.Cells(PNum, 9) = oObj.Volume
.Cells(PNum, 10) = oObj.Area
End If
If oObj.ObjectName = "AcDbRegion" Then
Set oTmp = oObj
pBase = oObj.Position
.Cells(PNum, 6) = "" 'pBase(0)
.Cells(PNum, 7) = "" 'pBase(1)
.Cells(PNum, 8) = "" 'pBase(2)
.Cells(PNum, 9) = oObj.Perimeter
.Cells(PNum, 10) = oObj.Area
End If
If oObj.ObjectName = "AcDbBlockReference" Then
pBase = oObj.InsertionPoint
.Cells(PNum, 6) = pBase(0)
.Cells(PNum, 7) = pBase(1)
.Cells(PNum, 8) = pBase(2)
.Cells(PNum, 9) = oObj.EffectiveName
.Cells(PNum, 10) = ""
End If
PNum = PNum + 1
End If
Next oObj
End With
Exit Sub
fin:
MsgBox "Un fichier excel doit être ouvert", vbExclamation
End Sub