Les contrôles ne sont pas obligatoires !
Pour preuve, la macro qui suit ne possède aucun contrôle. Dans ce cas, ce serait inutile et plutôt préjudiciable à la rapidité.
Cette macro se lancera à partir d'une icône dans AutoCAD. L'utilisation de VBA sera transparente, tout comme une routine AutoLisp.
Si vous voulez comparer, vous trouverez l'équivalent de cette routine écrite en AutoLISP, dans la rubrique Freewares

1. Point de départ du grand axe : Cliquez le point ou tapez les coordonnées.
2. Autre extrémité du grand axe : Cliquez le point ou tapez les coordonnées.
3. Rayon de l'oblong : Tapez une valeur au clavier ou cliquez un point. Si vous cliquez un point, c'est la distance de ce point au point précédent qui sera considérée comme rayon de l'oblong.
4. Epaisseur du trait : Tapez une valeur ou validez sur Entrée pour une épaisseur de zéro.

1. Lancer AutoCAD.



2. Dans le menu déroulant Outils/Macro VBA, cliquez sur "Editeur Visual Basic" ou sur l'icône correspondante.



3. La fenêtre EDI de Microsoft Visual Basic s'ouvre.



4. Dans le menu Insertion, cliquez sur "Module".



5. La page de code "Module1" est affichée.



6. Dans cette page, écrivez le code ou faites un copier-coller du code donné dans le paragraphe suivant.



7. Vous pouvez tout de suite tester le programme en tapant, sous AutoCAD, à l'invite

   Commande: (command "_-VBARUN" "Boutonniere")
           

8. Vous pouvez également cliquer sur l'icône Exécuter la Macro, choisir Module1 ou Tous les modules standard puis Boutonnière.



9. Il vous reste à sauvegarder le projet sous le nom oblong.dvb

 Sub Boutonniere()

     'Initialisation des variables
     Dim BaBouton As Object              ' Nom de la variable objet Boutonniere
     Dim PtSommet(0 To 9) As Double      ' Sommets du rectangle
     Dim Pt01, Pt02 As Variant
     Dim PtRot(0 To 2) As Double
     Dim Rayon As Variant
     Dim Angl1, Long1, Diam As Double
     Dim xDist, yDist, zDist As Double
     Dim Centr1, EpPoly As Variant

     ' Entree des donnees
     Pt01 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Point de départ du grand axe : ")
     Pt02 = ThisDrawing.Utility.GetPoint(Pt01, "Autre extrémité du grand axe : ")
     Rayon = ThisDrawing.Utility.GetDistance(Pt02, "Rayon de l'oblong : ")
     On Error Resume Next
     EpPoly = ThisDrawing.Utility.GetDistance(, "Epaisseur du trait <0> :")
     If EpPoly = "" Then EpPoly = 0
     
     ' Calculs
     ' Angl1 est l'angle forme par le grand axe et l'horizontale
     ' Long1 est la longueur du grand axe
     ' Centr1 est le point au milieu du grand axe
     Angl1 = ThisDrawing.Utility.AngleFromXAxis(Pt01, Pt02)
     xDist = Pt01(0) - Pt02(0)
     yDist = Pt01(1) - Pt02(1)
     zDist = Pt01(2) - Pt02(2)
     Long1 = Sqr((Sqr((xDist ^ 2) + (yDist ^ 2)) ^ 2) + (zDist ^ 2))
     
     Diam = Rayon * 2
     Centr1 = ThisDrawing.Utility.PolarPoint(Pt01, Angl1, (Long1 * 0.5))
    
     ' Pour simplifier, on trace d'abord un rectangle horizontal, en lwpolyligne
     PtSommet(0) = Pt01(0) + Rayon                ' Coordonnee en X du premier point
     PtSommet(1) = Pt01(1)                        ' Coordonnee en Y du premier point
     PtSommet(2) = Pt01(0) + Long1 - Rayon        ' Coordonnee en X du 2ème point
     PtSommet(3) = Pt01(1)                        ' Coordonnee en Y du 2ème point
     PtSommet(4) = PtSommet(2)                    ' Coordonnee en X du 3ème point
     PtSommet(5) = Pt01(1) + Diam                 ' Coordonnee en Y du 3ème point
     PtSommet(6) = Pt01(0) + Rayon                ' Coordonnee en X du 4ème point
     PtSommet(7) = Pt01(1) + Diam                 ' Coordonnee en Y du 4ème point
     PtSommet(8) = Pt01(0) + Rayon                ' Coordonnee en X du premier point pour clore
     PtSommet(9) = Pt01(1)                        ' Coordonnee en Y du premier point pour clore
     PtRot(0) = Pt01(0) + (Long1 * 0.5)
     PtRot(1) = Pt01(1) + Rayon
     PtRot(2) = Pt01(2)

     ' Dessin du rectangle
     Set BaBouton = ThisDrawing.ModelSpace.AddLightWeightPolyline(PtSommet)
     ' Dessin des demi-cercles
     Call BaBouton.SetBulge(1, 1)
     Call BaBouton.SetBulge(3, 1)
     ' Epaisseur de chaque segment de la polyligne
     Call BaBouton.SetWidth(0, EpPoly, EpPoly)
     Call BaBouton.SetWidth(1, EpPoly, EpPoly)
     Call BaBouton.SetWidth(2, EpPoly, EpPoly)
     Call BaBouton.SetWidth(3, EpPoly, EpPoly)
     BaBouton.Closed = True
     ' Deplacement de la boutonniere
     Call BaBouton.Move(PtRot, Centr1)
     ' Rotation de la boutonniere
     Call BaBouton.Rotate(Centr1, Angl1)
     BaBouton.Update          ' Mise a jour de l'affichage

End Sub

 
    
;;; ACAD.LSP     (C) R.ROSEC   FASOFT  04/04/98 Màj 03/07/98
;;; Chargement automatique des commandes BiRaRR et du menu correspondant
;;; Pour version 14 et ultérieures
;;;
;;; Pour R14 supprimer la ligne "command menuload" après la 1ère installation
;;; Voir la FAQ Autolisp pour plus d'explications

(defun S::BIRARR()
  (load"ra" -1)
  (load"tbox" -1)
  (load"perp" -1)
  (load"birarr" -1)
  (autoarxload"porte.arx" '("porte"))
  (autoarxload"ecrou.arx" '("ecrou"))
  (autoarxload"poutrl.arx" '("poutrl"))
  (setq *filedia* (getvar "filedia"))
  (setvar "filedia" 0)
;;  Pour la version AutoCAD 14, supprimer les 2 lignes suivantes
;;  (command "_menuload" "birarr")
;;  (menucmd "P7=+BiRaRR.pop1")
  (setvar "filedia" *filedia*)
 

;; les lignes suivantes concernent la macro Boutonniere
  (defun oblong()
    (setq *filedia* (getvar "filedia"))
    (setvar "filedia" 0) 
;;  Modifiez la ligne suivante en fonction de votre propre chemin   
    (command "_vbaload" "c:\\acadr14\\vbamacro\\oblong.dvb")
    (command "_-vbarun" "boutonniere")
    (setvar "filedia" *filedia*)
  )
;; fin de l'additif pour Boutonniere
 

)
(setq S::STARTUP
  (if (and S::STARTUP (listp S::STARTUP))
     (append S::STARTUP (cdr S::BIRARR))
      S::BIRARR 
  )
)

 
//
//      AutoCAD menu fichier - C:\ACADR14\SUPPORT\Birarr.mns

***MENUGROUP=BiRaRR

***POP1
ID_BiRaRR      [&BiRaRR]
               [&RAllonge ou RAccourcit]^C^C^PRA 
               [Perpen&Diculaire]^C^C^PPerp 
               [&Texte en Boîte]^C^PTbox 
               [&Boutonnière]^C^C^P(Oblong)      
               [--]
               [Dessin d'&Ecrous]^C^C^Pecrou 
               [Dessin de &Portes]^C^C^Pporte 
               [Poutre&Lles]^C^C^Ppoutrl 

***TOOLBARS
**BIRARR
ID_BiRaRR      [_Toolbar("BiRaRR", _Floating, _Show, 585, 134, 1)]
ID_CA109       [_Button("RA", "ICON109p.bmp", "ICON109g.bmp")]^C^CRA 
ID_CA214       [_Button("PERP", "ICON214p.bmp", "ICON214g.bmp")]^C^Cperp 
ID_CA215       [_Button("TBox", "ICON215p.bmp", "ICON215g.bmp")]^C^Ctbox 
ID_CA336       [_Button("Boutonnière", "ICON336p.bmp", "ICON336g.bmp")]^C^C(Oblong) 
ID_CA239       [_Button("Ecrous", "ICON239p.bmp", "ICON239g.bmp")]^C^Cecrou 
ID_CA233       [_Button("Poutrelles", "ICON233p.bmp", "ICON233g.bmp")]^C^Cpoutrl 
ID_CA235       [_Button("Porte", "ICON235p.bmp", "ICON235g.bmp")]^C^Cporte 

***HELPSTRINGS
ID_CA233       [Dessin de profilés et poutrelles]
ID_CA235       [Dessin de portes]
ID_CA214       [Tracé de Perpendiculaire à une droite]
ID_CA215       [Dessine un cadre autour d'un texte]
ID_CA239       [Dessine des écrous et rondelles.]
ID_CA109       [RAllonge ou RAccourcit une ligne ou polyligne]
ID_CA336       [Dessine un oblong]

//      Fin du menu fichier AutoCAD - C:\ACADR14\SUPPORT\Birarr.mns
         

• le projet Oblong.dvb
• le fichier acad.lsp
• le menu BiRaRR.mns
• les 2 icônes BMP