Marquer le CdG
Une nouvelle macro, après une longue absence ! Merci pour vos visites, il n'y a pas beaucoup de commentaires mais les statistiques indiquent des visites de plus en plus nombreuses !
Définition :
Aujourd'hui, une macro "graphique" puisqu'elle va nous permettre de tracer sur le dessin le centre de gravité d'une région préalablement définie. Le symbole du centre de gravité sera un cercle avec à l'intérieur deux traits en croix à 45°.
Avant : définition des régions :
Après un clic sur ces régions, le centre de gravité est marqué :
Explications :
Cette macro est composée de 4 fonctions et de deux procédures dont une principale
Les fonctions sont celles vues avec la macro de la flèche paramétrée et elles font les opérations sur les vecteurs. Ces fonctions sont appelées par la procédure DessinSymbCdG, procédure traçant le rond avec les traits à 45°.
Cette procédure est elle même appelée par la procédure principale qui sélectionne la région et en extrait le CdG.
Algorithmes :
Procédure principale CdG()
- invite à sélectionner une région
- test pour vérifier si l'objet est une région
- si c'est une région :
- extraire la position du CdG en X
- extraire la position du CdG en Y
- extraire la position du CdG en Z
- lancer la procédure de tracé du symbole avec en paramètre la position du CdG
- si ce n'est pas une région, message d'erreur
- boucle la procédure pour relancer une nouvelle sélection
Procédure secondaire DessinSymbCdG
- reçoit en paramètre la position du CdG
- défini la taille du symbole (10 mm)
- défini un vecteur unitaire horizontal de longueur 1
- fait une première rotation du vecteur unitaire de 45°
- défini le premier point à partir de la position du CdG, 10 mm en direction du vecteur unitaire
- défini le deuxième point à partir de la position du CdG, 10 mm en direction inverse du vecteur unitaire
- fait une deuxième rotation du vecteur unitaire de 90°
- défini le troisème point à partir de la position du CdG, 10 mm en direction du vecteur unitaire
- défini le quatrième point à partir de la position du CdG, 10 mm en direction inverse du vecteur unitaire
- trace les 2 traits définis par le 1er et 2e point et par le 3e et 4e point.
- fini en traçant un cercle de cercle CdG et de rayon égal à la taille du symbole.
Code :
A copier et à coller dans un module
'Cette macro trouve la position du centre de gravité d'une région
'et la trace dans l'espace objet.
Sub CdG()
Dim objSelectionne As AcadObject
Dim objRegion As AcadRegion
Dim pntPoint As Variant
Dim tableau(0 To 2) As Double
Dim pntCdG As Variant
On Error GoTo GestErrCdG 'Si la touche Echap est appuyée
Do 'mise en boucle de la fonction
'Sélection de la région
ThisDrawing.Utility.GetEntity objSelectionne, pntPoint, "Selectionner une région ou cliquer dans le vide pour quitter "
'Vérification de l'objet sélectionné : si région, extraire le centre de gravité, sinon message d'erreur
If objSelectionne.ObjectName = "AcDbRegion" Then
Set objRegion = objSelectionne
tableau(0) = objRegion.Centroid(0) 'position en x du CdG
tableau(1) = objRegion.Centroid(1) 'position en y du CdG
tableau(2) = 0 'position en z du CdG (ubne région ne semble pas avoir d'altitude !
pntCdG = tableau 'On met ces 3 coordonnées dans un point ACAD (type variant)
DessinSymbCdG (pntCdG) 'Dessin du symbole du CdG dans l'espace objet)
Else
MsgBox "Ceci n'est pas une région !"
End If
Loop
GestErrCdG: 'Gestionnaire d'erreur : sort de la macro quand ECHAP est actionné
Exit Sub
End Sub
'Cette macro dessine le symbole du CdG dans l'espace objet
'(un cercle avec une croix à 45° à l'intérieur)
Private Sub DessinSymbCdG(pntCdG As Variant)
Dim pnt1 As Variant
Dim pnt2 As Variant
Dim pnt3 As Variant
Dim pnt4 As Variant
Dim tableau(0 To 2) As Double
Dim VectUnit As Variant
Dim TailleSymbole As Double
Dim objLigne1 As AcadLine
Dim objLigne2 As AcadLine
Dim objCercle As AcadCircle
TailleSymbole = 10
tableau(0) = 1
tableau(1) = 0
tableau(2) = 0
VectUnit = tableau
VectUnit = rotVecteur(VectUnit, 45)
pnt1 = addVecteur(pntCdG, VectUnit, TailleSymbole)
pnt2 = addVecteur(pntCdG, VectUnit, TailleSymbole * -1)
VectUnit = rotVecteur(VectUnit, 90)
pnt3 = addVecteur(pntCdG, VectUnit, TailleSymbole)
pnt4 = addVecteur(pntCdG, VectUnit, TailleSymbole * -1)
Set objLigne1 = ThisDrawing.ModelSpace.AddLine(pnt1, pnt2)
Set objLigne2 = ThisDrawing.ModelSpace.AddLine(pnt3, pnt4)
Set objCercle = ThisDrawing.ModelSpace.AddCircle(pntCdG, TailleSymbole)
End Sub
'Déplace un point suivant un vecteur
Private Function addVecteur(pointA, vecteur, Optional longueur As Double) As Variant
Dim tableau(0 To 2) As Double
If longueur = 0 Then longueur = 1
tableau(0) = x_of(pointA) + x_of(vecteur) * longueur
tableau(1) = y_of(pointA) + y_of(vecteur) * longueur
tableau(2) = 0
addVecteur = tableau
End Function
'Rotation d'un vecteur d'un angle "ang"
Private Function rotVecteur(vecteur As Variant, ang As Double) As Variant
Dim tableau(0 To 2) As Double
ang = ang * 4 * Atn(1) / 180 '4 * atn(0) = PI
tableau(0) = x_of(vecteur) * Cos(ang) - y_of(vecteur) * Sin(ang)
tableau(1) = x_of(vecteur) * Sin(ang) + y_of(vecteur) * Cos(ang)
tableau(2) = 0
rotVecteur = tableau
End Function
'Extrait la valeur x d'un point
Private Function x_of(pnt As Variant) As Double
x_of = pnt(0)
End Function
'Extrait la valeur y d'un point
Private Function y_of(pnt As Variant) As Double
y_of = pnt(1)
End Function
J'espère que ce code est clair pour vous et qu'il vous sera utile. N'hésitez pas à poster vos commentaires et améliorations, la connaissance ne s'accroissant qu'avec le partage !
/https%3A%2F%2Fassets.over-blog.com%2Ft%2Fcedistic%2Fcamera.png)
/https%3A%2F%2Fstorage.canalblog.com%2F47%2F72%2F437679%2F90189496_o.png)