Tracé d'une flèche selon un angle

[pascal82]

Bonjour à tous,

J'aimerai visualiser par tracé d' une flèche la direction du vent en automatique mais je ne sais pas comment procéder ni par ou commencer.
PS: Je n'ai pas besoin d'une très grande précision, juste un aspect visuel

Merci pour votre aide

 

[pascal82]

Re : Tracé d'une flèche selon un angle

Bonjour JOB

Un grand merci pour ta contribution et la qualité de ta réponse.
La macro est complexe, meme avec les commentaires.

Cordialement

 

[pierrejean]

Re : Tracé d'une flèche selon un angle

Re

pascal , as-tu remarqué que la vitesse du vent (B2) influence la longueur de la fleche (dans le fichier de mon ami job 🙂 ) ?

 

[job75]

Re : Tracé d'une flèche selon un angle

Bonjour pierrejean, merci pour ton Like 🙂🙂

pascal , as-tu remarqué que la vitesse du vent (B2) influence la longueur de la fleche (dans le fichier de mon ami job 🙂 ) ?

Oui, et d'ailleurs si cette vitesse devient trop grande cela pose problème car la flèche devrait sortir de la feuille.

Comme elle ne le peut pas, elle se décale et n'est plus sur le centre du cercle.

Le fichier joint remédie à cette situation grâce à cette itération :

1 x2 = Cx + (d + vent) * Sin(Ar)
  y2 = Cy - (d + vent) * Cos(Ar)
  If x2 < 0 Or y2 < 0 Then vent = vent - 1: GoTo 1

A+

 

[pierrejean]

Re : Tracé d'une flèche selon un angle

Re

l'emulation etant une excellente chose

Voici ma version integrant les plus de la version de job à savoir:
- le cercle peut changer de place et de taille ,la fleche suivra (apres tout de même modif de B1 ou B2)
- la vitesse du vent influe sur la longueur de la fleche

 

[lanier2]

Re : Tracé d'une flèche selon un angle

Bonjour pascal82, pierrejean,

Voici une solution avec les retournements évoqués au post #2.

Avec la flèche de votre fichier (connecteur), les retournements ne se faisaient pas.

J'ai recréé la flèche avec la barre d'outil Dessin (Trait).

L'orientation de la flèche est mémorisée dans le nom défini Quart.

A+

Bonjour
Pourrais tu faire évoluer ta macro pour obtenir 4 fleches ou + pour 4 intensités ou + et 4 forces ou + par exemple ?
350 5 fleche
340 5,6 fleche
330 3,7 fleche
320 2,7 fleche
Etc...
David

 

[job75]

Bonsoir lanier2, bienvenue sur XLD,

Il ne me paraît guère utile de créer 4 flèches sur le fichier du post #18.

Il vaut mieux mettre des listes de validation en B1 et B2 avec 4 valeurs (ou +) dans chacune.

Cela donne 16 solutions (ou +) possibles.

A+

 

[lanier2]

Bonsoir lanier2, bienvenue sur XLD,

Il ne me paraît guère utile de créer 4 flèches sur le fichier du post #18.

Il vaut mieux mettre des listes de validation en B1 et B2 avec 4 valeurs (ou +) dans chacune.

Cela donne 16 solutions (ou +) possibles.

A+

Merci pour ta réponse
Ci joint un exemple de ce que j'aimerai si c'est possible
Dans cet exemple j'ai positionné les fleches manuellement
Est ce possile avec une macro ? type ci dessus
David

 

[job75]

C'est possible mais je n'ai pas du tout l'intention de créer 6 flèches avec 6 codes identiques.

 

[lanier2]

C'est possible mais je n'ai pas du tout l'intention de créer 6 flèches avec 6 codes identiques.

Bjr
On ne peut pas faire une macro unique car j'ai essayé mais sans succès
Merci
David

 

[job75]

Bjr
On ne peut pas faire une macro unique car j'ai essayé mais sans succès

On peut toujours faire :

Sub Macro()
Macro1
Macro2
Macro3
Macro4
Macro5
Macro6
End Sub

 

[lanier2]

On peut toujours faire :

Sub Macro()
Macro1
Macro2
Macro3
Macro4
Macro5
Macro6
End Sub

Ok j'ai réussi
Dans ta Macro la fleche est centrée par la point au milieu du cercle
Peut t on la centrer au milieu du cercle par le milieu de la fleche (et non la pointe)
Merci

 

[job75]

Bonjour lanier2, le forum,

Dans ta Macro la fleche est centrée par la point au milieu du cercle
Peut t on la centrer au milieu du cercle par le milieu de la fleche (et non la pointe)

Dans la macro du post #18 il suffit de remplacer l'instruction d = 0 par d = -vent / 2

A+

 

[lanier2]

Bonjour lanier2, le forum,

Dans la macro du post #18 il suffit de remplacer l'instruction d = 0 par d = -vent / 2

A+

Ok merci
Et avec le script ci dessous ?

Sub vent()
coeff_vitesse = Range("B2") / 13 ' 13 arbitraire pour avoir environ 100km/h sur le cercle
long_fleche = ActiveSheet.Shapes("Flowchart: Or 2").Width / 2
' calcul des coordonnées du centre du cercle nb: legerement modifié pour qu'il soit reellement circulaire
x_centre = ActiveSheet.Shapes("Flowchart: Or 2").Left - long_fleche
y_centre = ActiveSheet.Shapes("Flowchart: Or 2").Top - long_fleche
' equation pour ramener l'angle a la valeur correspondante au cercle trigonometrique
a = 360 - Range("B1") + 90
'calcul de la posion horizontale de la queue de la fleche
x = x_centre + long_fleche * coeff_vitesse * Cos(a * Application.Pi / 180)
'calcul de la posion verticale de la queue de la fleche
y = y_centre - long_fleche * coeff_vitesse * Sin(a * Application.Pi / 180)
'suppression de la fleche
ActiveSheet.Shapes("Fleche").Delete

'création d'une nouvelle fleche selon les coordonnées calculées
ActiveSheet.Shapes.AddLine(x_centre, y, x, y_centre).Select
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
Selection.ShapeRange.Flip msoFlipVertical
Selection.ShapeRange.Line.Weight = 6#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Line.BeginArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
' nommer la nouvelle fleche
Selection.ShapeRange.Name = "Fleche"

End Sub

 

[jurassic pork]

Hello,
voici un code pour faire une rotation d'une forme (ex flèche) par son centre :

Sub CenterRotation(shape As shape, rotAngle As Double)
    Dim rad As Double, x As Double, y As Double
    Dim x1 As Double, x2 As Double
    x = shape.Top: y = shape.Left
    x1 = (shape.Width / 2) * -1
    x2 = shape.Height
    rad = rotAngle * Atn(1) / 45
    With shape
        .Top = x + (.Height - .Width / 2 - x1 - x2) * (1 - Cos(rad)) / 2
        .Left = y + (.Height - .Width / 2 - x1 - x2) * Sin(rad) / 2
        .Rotation = rotAngle
    End With
End Sub

Sub TestCenterRotation()
CenterRotation ActiveSheet.Shapes("Vent"), 80
End Sub

Ce qui m'inquiète c'est que d'après le post #22 tu veux placer les flèches dans un rectangle. Si tu veux que la longueur de la flèche représente la vitesse du vent et que la flèche tienne dans le rectangle , il va falloir aussi rechanger la longueur de la flèche en fonction de l'angle ( vent du nord petit côté rectangle <> vent d'ouest grand côté rectangle)

Exemple pour une rotation de flèche :

Sub TestCenterRotation()
Dim Angles(), Angle
Angles = Array(0, 45, 90, 135, 180, 225, 270, 315, 360)
For Each Angle In Angles
  CenterRotation ActiveSheet.Shapes("Vent"), Angle
  Application.Wait Now + TimeValue("0:00:01")
Next
End Sub

Ami calmant, J.P

 

[job75]

Et avec le script ci dessous ?

S'il marche tant mieux, s'il ne marche pas débrouillez-vous.

Moi je reste sur ma macro du post #18 🙄