Dessiner des entités
depuis VBA AutoCAD

 

Pour ne pas se mélanger les pinceaux en livrant trop d'informations en apprentissage, je donne des exemples avec les point définis dans le programme (en dur), le choix des points à l'écran et le dessin des entités en découlant fera l'objet d'une page dédiée, on n'en est qu'aux débuts.
Cette page restant la base, le minimum vital pour que les entités existent.
C'est une première approche qui sera peaufinée dans les futures pages...

Cliquez sur le type d'entité dans cette liste pour vous rendre directement au chapitre dans la page.

• Ligne
• Cercle
• Texte
• Polylignes (2D et 3D)

---

Dessiner une LIGNE

Commençons simple, comme la première entité dessinée la première fois à l'écran graphique faisons une ligne.
En préambule, commencez un dessin vierge et lancez VBAIDE
Une ligne a besoin d'un point de départ et d'un point d'arrivée, il n'y a pas plus simple
Tout d'abord pour "voir" comment se fera la ligne, je vais faire un exemple en écrivant les valeurs des points dans le programme, on choisira à l'écran plus tard. C'est parti...

Sub Dess_Ligne()

'Initialisation des variables
    Dim Ma_Ligne As AcadLine       ' Variable objet ligne
    Dim PtDep(0 To 2) As Double   ' Variable Point départ
    Dim PtFin(0 To 2) As Double   ' Variable Point arrivée
    
    PtDep(0) = 1      ' X du Point départ
    PtDep(1) = 5      ' Y du Point départ
    PtDep(2) = 0      ' Z du Point départ
                
    PtFin(0) = 10     ' X du Point arrivée
    PtFin(1) = 15     ' Y du Point arrivée
    PtFin(2) = 0      ' Z du Point arrivée
    
'Creation de la ligne qui sera dessinée dans l'espace Objet
    
    Set Ma_Ligne = ThisDrawing.ModelSpace.AddLine(PtDep, PtFin)
    
End Sub

Ouah ! Ça marche,
Oui, vous avez fait un programme VBA
Non, vérifiez votre frappe et votre syntaxe et ça va marcher, vous y êtes presque.

Vous remarquez que les valeurs x y z des points sont "rangées" dans un tableau, c'est ainsi que le X va dans le premier élément, le Y dans le deuxième et le Z dans le troisième pour chaque point.
Ensuite il ne reste qu'à lancer la création de l'objet (déclaré comme tel dans Ma_Ligne) et c'est fini.

L'explication de la dernière ligne semble superflue, mais je la décortique tout de même :
ThisDrawing   signifie le dessin depuis lequel est lancée la macro
ModelSpace    est l'espace Objet (PaperSpace étant l'espace Papier)
AddLine           est la fonction VBA d'ajout de ligne dans le dessin.
Entre parenthèses les arguments Point de départ et Point de fin, vous êtes OK ?

---

Dessiner un Cercle

Sub Dess_Cercle()

'Initialisation des variables
    Dim Mon_Cercle As AcadCircle  ' Variable objet Cercle
    Dim PtCen(0 To 2) As Double   ' Variable Point Centre
    Dim ValRayon As Double        ' Variable Rayon
    
    PtCen(0) = 1      ' X du Point Centre
    PtCen(1) = 5      ' Y du Point Centre
    PtCen(2) = 0      ' Z du Point Centre
    
    ValRayon = 5.5    ' Valeur du rayon
        
'Creation du cercle sera dessiné dans l'espace Objet
    
    Set Mon_Cercle = ThisDrawing.ModelSpace.AddCircle(PtCen, ValRayon)
    
End Sub

Et voilà ... Tout fonctionne correctement ?

---

Dessiner un TEXTE

L'insertion ou plus précisément le dessin d'une entité TEXTE ne pose pas plus de souci que les premiers exemples, il faut donc : le point d'insertion, le contenu de la chaine de texte et l'angle de rotation (par rapport à l'axe des X).
Travaillez dans un dessin vierge pour voir le texte qui se positionnera en x=10.00, y= 200.00,z= 0.00
Voici le code :

Sub CreateText()

'déclaration des variables
Dim ObjTexte As AcadText 
Dim InsPoint(0 To 2) As Double
Dim Haul_Texte As Double
Dim Val_Texte As String

'affectation des variables
InsPoint(0) = 10
InsPoint(1) = 200
InsPoint(2) = 0
Haul_Texte = 10
Val_Texte = "Texte inséré en VBA"

Set ObjTexte = ThisDrawing.ModelSpace.AddText(Val_Texte, InsPoint, Haul_Texte)
ObjTexte.Rotation = 0 ' l'angle 0 (zéro) est la direction des X


'zoom TOUT
ZoomAll

End Sub

Je vous souhaite que tout fonctionne, car c'est toujours un plaisir de voir l'ordinateur travailler à notre place.

---

Dessiner une polyligne (2D ou 3D)

Ce cas est un tantinet plus compliqué, car on conçoit qu'il faut bien plus de points de définition, une fois ce souci géré le dessin s'ordonne en une ligne de code.
Une page au sujet des instructions nécessaires au remplissage d'un tableau par programme va bientôt être disponible.
Les points sont enregistrés dans un tableau à deux dimensions, le nombre de rangées est le nombre de points et les trois colonnes sont les x y et z.
- Si c'est une polyline 2D que vous souhaitez dessiner, le renseignement du z n'est pas nécessaire et un tableau à deux dimensions de deux colonnes est suffisant, toutefois si un tableau à trois colonnes est en paramètre cela fonctionnera et dessinera une polyligne 2D, mais sans prendre en compte cette altitude.
- Pour les cas de la polyligne3D le Z devient obligatoire, même si c'est la valeur 0 (zéro) il faut une valeur Z et donc un tableau à trois colonnes.
Dans l'exemple de code suivant je dessine deux polylignes, une 2D et une 3D, les commentaires devraient vous aider à comprendre le processus.
J'en profite pour accéder aux propriétés de l'objet créé en modifiant sa couleur, la première est forcée en ROUGE en utilisant acREd et la seconde en BLEU avec acBlue, comme vous le constatez l'accès aux propriétés est assez aisé. Une page à propos des couleurs va bientôt voir le jour...

Sub Create_Polyline_2D_3D()

'déclaration des variables
Dim pline2DObj As AcadLWPolyline
Dim pline3DObj As Acad3DPolyline
Dim points2D(0 To 5) As Double
Dim points3D(0 To 8) As Double

' tableau de points 2D
points2D(0) = 1: points2D(1) = 1
points2D(2) = 1: points2D(3) = 2
points2D(4) = 2: points2D(5) = 2

' tableau de points 3D
points3D(0) = 1: points3D(1) = 1: points3D(2) = 0
points3D(3) = 2: points3D(4) = 1: points3D(5) = 2
points3D(6) = 2: points3D(7) = 2: points3D(8) = 0

' Création de la poly 2D
Set pline2DObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points2D)

' affectation de la couleur rouge à cette polyligne
pline2DObj.color = acRed

' Création de la polyligne 3D
Set pline3DObj = ThisDrawing.ModelSpace.Add3DPoly(points3D)

' affectation de la couleur bleu à cette polyligne
pline3DObj.color = acBlue

ZoomExtents

End Sub

Ce dernier code a fonctionné ? Vous devriez voir un carré en plan séparé en deux parties une rouge et l'autre bleue, c'est bien le cas (j'espère) ?
En vous mettant en vue 3D, Orbite ou Shift bouton milieu souris, vous pouvez vous rendre compte que la partie bleue est bel et bien une Poly3D avec un sommet à l'altitude 5.00.

Bon j'arrête là mes exemples, mais je reste à votre disposition par le formulaire CONTACT pour tout renseignement ou modification de la page.
Je complèterai au fur et à mesure...

---

Création 03 mai 2021