je vien de récrire mon mdule en polyline. mais j'ai une ligne qui bug
et mon niveau est plus que limiter.
j'utilise l'aide pour travaillé et je ne voi pas mon erreur.
si tu as une idée
d'avance merci
Sub test()
'
'Attention le fichier xls doit être ouvert
'
Dim MyXl As Object
Dim Polylineobj As AcadLWPolyline
Dim VerticesList(0 To 2) As Double
Dim RetVal(0 To 2) As Double
'remplacer "c:\toto.xls" par le nom du fichier
Set MyXl = GetObject("C:\Toto.xls" )
'remplacer "Feuil1" par le nom de la feuille
Set Obj = MyXl.Worksheets("VBA-5" )
i = 1
While IsEmpty(Obj.Cells(1, i).Value) = False
j = 2
While IsEmpty(Obj.Cells(j, i).Value) = False
VerticesList(0) = Obj.Cells(j, i).Value
VerticesList(1) = Obj.Cells(j, i + 1).Value
VerticesList(2) = 0#
j = j + 1
RetVal(0) = Obj.Cells(j, i).Value
RetVal(1) = Obj.Cells(j, i + 1).Value
RetVal(2) = 0#
If IsEmpty(Obj.Cells(j, i).Value) = False Then
Set AcadLWPolyline = ModelSpace.AddPolyline(VerticesList, RetVal
End If
Wend
i = i + 2
Wend
Set Obj = MyXl.Worksheets("VBA-5" )
Dim Point1(0 To 2) As Double
Dim Point2(0 To 2) As Double
Point1(0) = 100: Point1(1) = 0: Point1(2) = 0
Point2(0) = 0: Point2(1) = 0: Point2(2) = 0
Polylineobj.move Point1, Point2
Polylineobj.Update
ZoomAll
End Sub