exporter les coordonnées d\'un polyligne 3D vers excel

[lovecraft]

Bonjour,

Ci-dessous une de mes premieres contribution.

 

cette routine permet d'exporter les coordonnées d'une polyligne 3D vers excel.

Si vous avez des commentaires ou des améliorations a apporter merci d'en faire part.

 

********************************************************************************

 

Sub OUVRIR_EXCEL()

 

Static applicationexcel As Object

Static classeurexcel As Object

Static feuilleexcel As Object

Dim valeur As String

 

Set applicationexcel = GetObject(, "excel.application") ' ouvre le classeur courant

Set applicationexcel = CreateObject("excel.application")

 

 

applicationexcel.Application.Visible = True

Set classeurexcel = applicationexcel.Workbooks.Add

Set feuilleexcel = applicationexcel.ActiveSheet

 

 

Dim selObj As AcadObject

 

Dim retCoord As Variant

Dim k, l As Integer

Dim nbr_of_segments As Long

Dim nbr_of_vertices As Long

Dim segment As Long

On Error Resume Next

ThisDrawing.Utility.GetEntity selObj, "Sélectionner une polyligne."

 

 

 

retCoord = selObj.Coordinates

h = selObj.Count

 

segment = 0

k = LBound(retCoord)

l = UBound(retCoord)

nbr_sommet = (((l - k) + 1) / 3)

 

'Ecriture dans excel

Dim i As Integer 'boucle x

Dim ii As Integer

Dim u As Integer 'boucle y

Dim j As Integer 'boucle z

 

 

'presentation tableau

feuilleexcel.Cells(6, 1).Value = "X"

feuilleexcel.Cells(6, 1).HorizontalAlignment = xlCenter

feuilleexcel.Cells(6, 2).Value = "Y"

feuilleexcel.Cells(6, 2).HorizontalAlignment = xlCenter

feuilleexcel.Cells(6, 3).Value = "Z"

feuilleexcel.Cells(6, 3).HorizontalAlignment = xlCenter

 

ii = 0

For i = k To l Step 3

feuilleexcel.Cells(7 + ii, 1).Value = retCoord(i)

ii = ii + 1

Next i

 

ii = 0

For u = 1 To l Step 3

feuilleexcel.Cells(7 + ii, 2).Value = retCoord(u)

ii = ii + 1

Next u

 

ii = 0

For j = 2 To l Step 3

feuilleexcel.Cells(7 + ii, 3).Value = retCoord(j)

ii = ii + 1

Next j

 

' Determine the number of segments in the polyline.

If selObj.Closed Then

nbr_of_segments = nbr_sommet

Else

nbr_of_segments = nbr_sommet - 1

End If

 

MsgBox "La polyligne sélectionnée est composée de " & nbr_of_segments & " segments."

 

****************************************************************************

 

 

 

End Sub

 

 

 

 

@plus