Exemple de création de hachures

Ca n'est pas aussi simple qu'on pourrait le croire. En effet, avant de pouvoir créer une hachure, il faut d'abord définir sa frontière... 

Code pour AutoCAD 2000: (pour AutoCAD R14, suivre ce lien)

Public Sub HachurerCarre()
      ' Exemple de création de hachures dans un carré de coté 1
      ' dont le coin gauche se situe aux coordonnées: 0,0,0
     
      ' Pts de construction de la polyligne
      Dim Pts(0 To 11) As Double
      
      ' Polyligne qui va servir de frontière aux hachures
      Dim ObjetPolyligne As AcadPolyline
      
      ' Tableau d'entité qui sera passé à la méthode AppendOuterLoop
      ' de l'objet hachures
      Dim Frontiere(0 To 0) As AcadEntity
      
      ' Objet hachures
      Dim ObjetHachures As AcadHatch
          
      ' Points du carré (qui est en fait une polyligne)
      Pts(0) = 0: Pts(1) = 0: Pts(2) = 0
      Pts(3) = 1: Pts(4) = 0: Pts(5) = 0
      Pts(6) = 1: Pts(7) = 1: Pts(8) = 0
      Pts(9) = 0: Pts(10) = 1: Pts(11) = 0
     
      ' On crée la polyligne
      Set ObjetPolyligne = ThisDrawing.ModelSpace.AddPolyline(Pts)
      
      ' On la ferme
      ObjetPolyligne.Closed = True
      
      ' On place la polyligne dans le tableau d'entités AutoCAD
      Set ObjetFrontiere(0) = ObjetPolyligne
     
      ' On crée la hachure
      Set ObjetHachures = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "ANSI31", True)
      
      ' On défini la frontière de l'objet hachures
      ObjetHachures.AppendOuterLoop (ObjetFrontiere)
      
      ' On change l'échelle d'hachurage
      ObjetHachures.PatternScale = 0.01
      
      ' On demande à AutoCAD de calculer les intersections des hachures
      ' et de la frontière
      ObjetHachures.Evaluate
      
      ' Zoom étendu (méthode de l'objet Application)
      ZoomExtents
    End Sub
 

Pour adapter ce code au V.B.A. fourni avec AutoCAD 14, il faut effectuer les modifications suivantes:

 Code pour AutoCAD 14: 

Public Sub HachurerCarre()
      ' Exemple de création de hachures dans un carré de coté 1
      ' dont le coin gauche se situe aux coordonnées: 0,0,0
     
      ' Pts de construction de la polyligne
      Dim Pts(0 To 11) As Double
      
      ' Polyligne qui va servir de frontière aux hachures
      Dim ObjetPolyligne As Object
      
      ' Tableau d'entité qui sera passé à la méthode AppendOuterLoop
      ' de l'objet hachures
      Dim Frontiere(0 To 0) As Object
      
      ' Objet hachures
      Dim ObjetHachures As Object
          
      ' Points du carré (qui est en fait une polyligne)
      Pts(0) = 0: Pts(1) = 0: Pts(2) = 0
      Pts(3) = 1: Pts(4) = 0: Pts(5) = 0
      Pts(6) = 1: Pts(7) = 1: Pts(8) = 0
      Pts(9) = 0: Pts(10) = 1: Pts(11) = 0
     
      ' On crée la polyligne
      Set ObjetPolyligne = ThisDrawing.ModelSpace.AddPolyline(Pts)
      
      ' On la ferme
      ObjetPolyligne.Closed = True
      
      ' On place la polyligne dans le tableau d'entités AutoCAD
      Set ObjetFrontiere(0) = ObjetPolyligne
     
      ' On crée la hachure
      Set ObjetHachures = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "ANSI31", True)
      
      ' On défini la frontière de l'objet hachures
      ObjetHachures.AppendOuterLoop (ObjetFrontiere)
      
      ' On change l'échelle d'hachurage
      ObjetHachures.PatternScale = 0.01
      
      ' On demande à AutoCAD de calculer les intersections des hachures
      ' et de la frontière
      ObjetHachures.Evaluate
      
      ' Zoom étendu (méthode des objets ViewPort)
      ActiveViewport.ZoomExtents
    End Sub