1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
   | Sub test()
Dim AutoApp As Object
Dim DocAutoCad As Object
Dim InsertCadre(0 To 4) As Double
Set AutoApp = CreateObject("AutoCAD.Application")
Set DocAutoCad = AutoApp.Documents.Add
AutoApp.Visible = True
          InsertCadre(0) = 41
          InsertCadre(1) = 20
          InsertCadre(2) = 57
          InsertCadre(3) = 25
         CrateCadre DocAutoCad, InsertCadre, 1
End Sub
 
Public Function CrateCadre(MyDocumment, InsertPointCadre, Couleur As Long)
  Dim points(0 To 14) As Double
 
 
    points(0) = InsertPointCadre(0): points(1) = InsertPointCadre(1): points(2) = 0
    points(3) = InsertPointCadre(2): points(4) = InsertPointCadre(1): points(5) = 0
    points(6) = InsertPointCadre(2): points(7) = InsertPointCadre(3): points(8) = 0
    points(9) = InsertPointCadre(0): points(10) = InsertPointCadre(3): points(11) = 0
    points(12) = InsertPointCadre(0): points(13) = InsertPointCadre(1): points(14) = 0
    Set CrateCadre = MyDocumment.ModelSpace.AddPolyline(points)
 
CrateCadre.Color = Couleur
End Function | 
Partager