XL 2016 VBA - Déterminer la pente de la Forme ligne ou flèche ou mieux son équation

[Dudu2]

Bonjour,

J'ai 2 Shapes msoLine.
Toutes les 2 ont les mêmes caractéristiques de position (Left, Top) mais ont des pentes opposées.
Comment puis-je déterminer la pente (ascendante ou descendante) de la ligne d'une Shape msoLine ?

 

[Dudu2]

Salut @patricktoulon,
Astuce alternative tout à fait valable. Bien joué !

 

[patricktoulon]

RE
démo complète avec les flip horizontal et vertical
avec carré vert pour le point d'intersection

Sub BTFLIPV_Cliquer()
    ActiveSheet.Shapes("ligne").Flip msoFlipVertical
End Sub
Sub BTFLIPH_Cliquer()
    ActiveSheet.Shapes("ligne").Flip msoFlipHorizontal
End Sub

Sub BTGO_Cliquer()
    CalculerDiagonaleRectangle2
End Sub

Sub CalculerDiagonaleRectangle2()
    On Error Resume Next
    ActiveSheet.Shapes("controleur").Delete
    On Error GoTo 0

    Dim Lg#, HT, Diagonale#, DiffWidth, L1#, L2


    Set SHAP = ActiveSheet.Shapes("ligne")
    Set shap2 = ActiveSheet.Shapes("rectrouge")

    'données de base
    Lg = SHAP.Width                 'largeur
    HT = SHAP.Height                'hauteur
    tp = SHAP.Top                   'top
    bottom = SHAP.Top + SHAP.Height    'bottom

    'Diagonale = Sqr(Ht ^ 2 + Lg ^ 2)'méthode math abrogée

    newtp = shap2.Top
    newht = bottom - newtp
    newlg = Lg / (HT / newht)    'reduit la largeur  au même ratio que la reduction du height
    DiffWidth = Abs(Lg - newlg)

    'MsgBox HT & vbCrLf & Lg & vbCrLf & vbCrLf & newht & vbCrLf & newlg

    'visuel de l'intersection des deux rectangles en ajoutant un rectangle vide borduré
    Set Shp = ActiveSheet.Shapes.AddShape(1, SHAP.Left, bottom - newht, newlg, newht)
    Shp.Name = "controleur"
    Shp.Fill.Visible = False
    Shp.Line.ForeColor.RGB = vbGreen




    With shap2
        L1 = SHAP.Left + newlg - (shap2.Width / 2)
        L2 = SHAP.Left + DiffWidth - (shap2.Width / 2)
        If SHAP.VerticalFlip Then
            If SHAP.HorizontalFlip Then .Left = L2 Else .Left = L1
            If SHAP.HorizontalFlip Then Shp.Left = SHAP.Left + SHAP.Width - Shp.Width Else Shp.Left = SHAP.Left
        Else
            If SHAP.HorizontalFlip Then .Left = L1 Else .Left = L2
            Shp.Left = SHAP.Left + DiffWidth
            If SHAP.HorizontalFlip Then Shp.Left = SHAP.Left Else Shp.Left = SHAP.Left + SHAP.Width - Shp.Width

        End If

    End With
End Sub

si on enlève tout ce qui a pour les visuel il reste plus grand chose

c'est diffwidth + les flip qui commandent

j'ai essayé avec le théorème de pitagore mais là encore on rencontre des petites variantes du à l'arrondissement de vba ou autre

 

[patricktoulon]

re
et la voilà réduit à une simple fonction donnant le left à appliquer
présentation et commentaire façon @Dudu2 en englouwish

Option Explicit
Function GetDiagonalPositionLeft(SHAP, SHAP2) As Double
'*****************************************
'Reposition in terms of left a shape(1) at the intersection of another shape(2) of type "MsoLine" according to the top of the shapes(1)
'Version coded by patricktoulon
'Version1 1.0
'Date version:08/04/2024
'Request from @Dudu2 in a discussion on ExcelDownloads
'https://excel-downloads.com/threads/vba-determiner-la-pente-de-la-forme-ligne-ou-fleche-ou-mieux-son-equation.20082379/page-2#posts
'*****************************************
    Dim Lg#, HT#, Tp#, NewTp#, NewLg#, NewHt, Bottom#, DiffWidth, L1#, L2, LF#

    'Position data and size of the shapes (SHAP2 = "LINE")
    Lg = SHAP.Width                 'Width of shape (MsoLine)
    HT = SHAP.Height                'Height of shape (MsoLine)
    Tp = SHAP.Top                   'Top of shape (MsoLine)
    Bottom = SHAP.Top + SHAP.Height 'Bottom of shape (MsoLine)

    NewTp = SHAP2.Top               'Width of  shape(Msoline or MsoArrow
    NewHt = Bottom - NewTp          'Height of intersection rectangle
    NewLg = Lg / (HT / NewHt)       'Reducing the width of the rectangle to the same ratio as reducing its height

    DiffWidth = Abs(Lg - NewLg)     'Difference in width of the two occupation rectangles

    'Two possibilities of left according to the vertical and horizontal flip rotation
    L1 = SHAP.Left + NewLg - (SHAP2.Width / 2)
    L2 = SHAP.Left + DiffWidth - (SHAP2.Width / 2)

    'Selection of one of the two possibilities depending on the flip
    If SHAP.VerticalFlip Then
        If SHAP.HorizontalFlip Then LF = L2 Else LF = L1
    Else
        If SHAP.HorizontalFlip Then LF = L1 Else LF = L2
    End If
    GetDiagonalPositionLeft = LF
End Function


Sub applique() 'SUB DE TEST
    Dim X#
    With ActiveSheet
        X = GetDiagonalPositionLeft(.Shapes("ligne"), .Shapes("rectrouge"))
        .Shapes("rectrouge").Left = X
    End With
End Sub

 

[TooFatBoy]

J'ai regardé ta macro ÉquationShapeLine, et je pense que ton test

If (.VerticalFlip = msoTrue And .HorizontalFlip = msoFalse) Or (.VerticalFlip = msoFalse And .HorizontalFlip = msoTrue)

doit logiquement, sauf erreur de ma part, pouvoir se "simplifier" à ceci :

If .VerticalFlip + .HorizontalFlip = 1

 

[Dudu2]

D'une part simplifier en réfléchissant trop je trouve qu'on perd en maintenabilité et en lisibilité.
Sauf si ça se justifie en terme de consommation de ressources.

D'autre part, Are you sure of the sign ???
Si (V = -1 et H = 0) ou (V = 0 et H = -1) -> V + H = -1 ou -1
Sinon (V = -1 et H = -1) ou (V = 0 et H = 0) -> V + H = -2 ou 0

 

[TooFatBoy]

C'était juste une idée en passant.

 

[Dudu2]

Bonjour,
Dans l'équation d'une droite j'ai oublié un cas.
Cas "standard": y = ax + b (il semble qu'on dise maintenant y = mx + p mais je le fais à l'ancienne)
Cas verticale (// à l'axe de ordonnées) : x = c
De plus dans le 1er cas, lorsque a = 0 (cas horizontale) on ne peut pas calculer x en fonction de y.

Donc j'ai modifié le Post #14 pour traiter ces particularités.

 

[TooFatBoy]

il semble qu'on dise maintenant y = mx + p mais je le fais à l'ancienne

Tant que tu n'en es pas à z=x+i*y, ça va.

 

[patricktoulon]

bonjour tout les deux
perso je trouve la méthode des deux rectangles d'occupation tellement plus simple
je n'inverse pas les calculs j'inverse simplement la différence des deux rectangle selon le flip

1° rectangle1=surface shape("ligne")
2° rectangle2 =surface shapes("ligne") dont le height est égal a lui même - le top du curseur a placer
en sauvegardant l'aspect ratio donc le width réduit aussi au prorata de la réduction height
3° la différence de width entre les deux
le left = cette différence qui va va a gauche ou a droite selon les flip

4° pour les flip je préfère les deux IF en cascade car il peut y avoir non pas deux possibilités mais 4
terminé

 

[Dudu2]

Bonjour @patricktoulon,
Certes, mais sans correction, ton code ne fonctionne pas non plus pour une ligne horizontale.
Division par 0.

 

[patricktoulon]

ben c’était pas la question du départ en fait ca peut être corrigé

cela dit je suis entrain de chercher car je crois que l'on fait une erreur monumentale

car:
imaginons
je dessine un trait(une shapes(msoline) dans n'importe quel sens au depart

a aucun moment le left ou le right ainsi que top et bottom ne change apres rotation verticale ou horizontale

ca veut dire que nos méthodes ne sont valables qu'une fois sur 4 possibilités

dans le sens ou je peux la dessiner dans un sens ou l'autre au départ

j'ai donc pris parti (encore une fois) de me battre avec le chat qui pète

punaise c'est un vrai champion olympique de natation celui là

ChatGPT

A conversational AI system that listens, learns, and challenges

chat.openai.com

 

[Dudu2]

Non, c'est simple, il suffit de vérifier si la Height = 0 et positionner en conséquence.
Ton code modifié.

 

[patricktoulon]

re oui ça j'avais compris c'est pas cela que je voulais dire

1. prends ton fichier avec ta méthode
2. supprime ta shape ligne et recrée la dans un sens(n'importe le quel) sans la faire fliper
3. ok tu teste c'est peut être bon
4. re supprime la à nouveau redessine la dans un autre sens (symétriquement) toujours pareil sans la fliper
5. et re teste normalement un des deux test doit être faux

c'est pour ça que je suis aller chercher le beginX ou y ou les shapes.nodes(1) et (2).points(x,x)
sauf que les msline n'ont pas de noeuds si elle ne sont pas connectés a d'autres shapes
donc c'est choux blanc
et pour le coup chatGpt est d'accords avec moi

 

[Dudu2]

et re teste normalement un des deux test doit être faux

Si tu parles de mon code, non. Car, pour déterminer l'équation de la ligne, je prends en compte les Flips V et H. Le fameux test simplifiable par @TooFatBoy Flip V + Flip H = -1.
J'ai modifié à nouveau le fichier du Post #14 pour introduire des boutons de Flip V et H comme je l'ai fait sur ton fichier modifié. C'est plus facile de Flipper la ligne que de la redessiner.

 

[patricktoulon]

je crois que tu ne m'a pas compris
je vais essayer moi même avec ton fichier
en attendant ce que j’essaie de dire c'est que si au départ tu dessine de ces 4 manières
aucune des 4 n'est flippée ni verticalement ni horizontalement
pourtant tu t'en doute bien que le placement serait différent

voilà ce que je voulais dire