|
SANS CONTROLE
|
|
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
|
|
Utilisation de la macro
|
 Le programme vous demandera :
- Point de départ du grand axe : Cliquez le point ou tapez les coordonnées.
- Autre extrémité du grand axe : Cliquez le point ou tapez les coordonnées.
- 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.
- Epaisseur du trait : Tapez une valeur ou validez sur Entrée pour une
épaisseur de zéro.
|
|
La partie VBA
|
- Lancer AutoCAD.
- Dans le menu déroulant Outils/Macro VBA, cliquez sur "Editeur Visual Basic"
ou sur l'icône correspondante.
- La fenêtre EDI de Microsoft Visual Basic s'ouvre.
- Dans le menu Insertion, cliquez sur "Module".
- La page de code "Module1" est affichée.
- Dans cette page, écrivez le code ou faites un copier-coller du code donné
dans le paragraphe suivant.
- Vous pouvez tout de suite tester le programme en tapant, sous AutoCAD, à l'invite
Commande: (command "_-VBARUN" "Boutonniere")
- Vous pouvez également cliquer sur l'icône Exécuter la Macro, choisir
Module1 ou Tous les modules standard puis Boutonnière.
- 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
|
