Coordonnées de points extérieurs

[maxdhavys]

Bonjour à tous et bonne année,

J'ai une quantité finie de rectangles (R1, R2, etc.) accolés dont je connais les coordonnées de chaque point.

Le point inférieur gauche du rectangle R1 a toujours pour coordonnées (0;0).

Ces rectangles forment un polygone à angles droits.

Ayant toutes ces infos et connaissant le point (0;0), je cherche à déterminer chacun des points extérieurs constituants ce polygone.

J'ai fait un xls qui permettra probablement de mieux comprendre ^^

Est-ce que quelqu'un pourrait m'aider à trouver une formule svp :?

 

[mapomme]

Re,

Je travaille avec des nombres ayant une décimale, exemple (1,2;4,9)

Du coup, ma méthode tombe à l'eau. 😵

 

[CISCO]

Bonjour

Re,
Du coup, ma méthode tombe à l'eau. 😵

Pas complètement, j'espère...

De mon coté, je rame. Pas évident...

@ plus

 

[maxdhavys]

Je pense que l'on pourra pas se passer de VBA pour ce problème 🙁

 

[CISCO]

Bonjour

Re,
Du coup, ma méthode tombe à l'eau. 😵

Peut être en multipliant par 10...

@ plus

 

[maxdhavys]

Pour vous en dire un peu plus sur l'application de ce sujet ; j'ai un algorithme qui génère des plans et je travaille sur l'étude quantitative de ces plans à travers laquelle je dois en partie séparer les murs intérieurs et extérieurs tout en trouvant les points extérieurs dans l'ordre.

 

[maxdhavys]

Pour information à qui le souhaite, j'ai la réponse en Python 😉

Très bonne continuation et à bientôt

 

[CISCO]

Bonsoir

Merci pour cette info.

@ plus

 

[eriiic]

Bonjour,

Je n'avais pas vu que c'était le demandeur qui avait sa solution en python.
Je met donc quand même ma proposition en vba.
J'ai ajouté en 1er point O (0,0 )
Reste à voir si cette solution traite aussi tous les cas plus 'tordus'.

Sub main()
    Dim datas, pts, dict, k
    Dim pl As Range, lig As Long, col As Long, ok As Boolean
    Dim v As Double, coord As Long, memo(1 To 2)
    Set dict = CreateObject("Scripting.Dictionary")

    'recup points
    Set pl = Cells.Find("Rectangles"): If pl Is Nothing Then Exit Sub
    Set pl = pl.CurrentRegion
    datas = pl.Offset(2, 1).Resize(pl.Rows.Count - 2, pl.Columns.Count - 1).Value

    ReDim pts(1 To pl.Rows.Count * pl.Columns.Count / 2, 1 To 2)
    For lig = 1 To UBound(datas)
        For col = 1 To UBound(datas, 2) Step 2
            dict(datas(lig, col) & ";" & datas(lig, col + 1)) = dict(datas(lig, col) & ";" & datas(lig, col + 1)) + 1
        Next col
    Next lig
    ' élaguer
    For Each k In dict
        If dict(k) Mod 2 = 0 Then dict.Remove k
    Next k
    ' ordonner
    ReDim pts(1 To dict.Count, 1 To 2)
    pts(1, 1) = 0: pts(1, 2) = 0
    dict.Remove "0;0"
    For lig = 2 To dict.Count + 1
        ok = False: memo(2) = 999999
        coord = lig Mod 2
        For Each k In dict
            If CDbl(Split(k, ";")(coord)) = pts(lig - 1, coord + 1) Then
                'même abcisse ou ordonnée selon si lig pair ou impair
                v = Abs(CDbl(Split(k, ";")(Abs(coord - 1))) - pts(lig - 1, Abs(coord - 2)))
                If v < memo(2) Then
                    ' + petite distance
                    memo(1) = k: memo(2) = v: ok = True
                End If
            End If
        Next k
        ' ajout point
        If ok Then
            pts(lig, 1) = CDbl(Split(memo(1), ";")(0)): pts(lig, 2) = CDbl(Split(memo(1), ";")(1))
            dict.Remove memo(1)
        Else
            MsgBox "Anomalie dans la continuité des points, abandon": Exit Sub
        End If
    Next lig
    Set dict = Nothing
    ' restitution
    Range([R6:S6], [R6:S6].End(xlDown)).Offset(, 1).ClearContents
    [S6:T6].Resize(UBound(pts)) = pts
End Sub

eric

 

[CISCO]

Bonjour

C'est quand même intéressant. Ne me reste plus qu'à essayer de comprendre...

@ plus

 

[eriiic]

Ce qui rend la compréhension difficile c'est le regroupement de 2 boucles en une pour l'ordonnancement.
Les 2 boucles d'origine pour simplifier la lecture

    ' ordonner
    ReDim pts(1 To dict.Count, 1 To 2)
    pts(1, 1) = 0: pts(1, 2) = 0
    dict.Remove "0;0"
    For lig = 2 To dict.Count
        If lig Mod 2 = 1 Then
            ok = False
            For Each k In dict
                If CDbl(Split(k, ";")(1)) = pts(lig - 1, 2) Then
                    dict.Remove k: ok = True: Exit For
                End If
            Next k
        Else
            For Each k In dict
                If CDbl(Split(k, ";")(0)) = pts(lig - 1, 1) Then
                    dict.Remove k: ok = True: Exit For
                End If
            Next k
        End If
        If ok Then
        pts(lig, 1) = CDbl(Split(k, ";")(0)): pts(lig, 2) = CDbl(Split(k, ";")(1))
        Else
            MsgBox "Anomalie dans la continuité des points, abandon": Exit Sub
        End If
    Next lig

Fourni juste pour l'aide à la lecture car incomplet. Je n'avais pas encore introduit la notion de distance qui m'est apparue plus tard.

Pour l'algorithme je me suis basé sur la remarque faite par Modeste : un point présent un nombre pair de fois n'est pas un 'sommet', ce qui se comprend sur la figure car dans ce cas ce sont 2 rectangles alignés. (Edit : ou un point commun à 4 rectangles... En fait ça rappelle le problème des ponts de koenigsbourg)
Et par un constat fait sur l'exemple fourni : 2 point consécutifs ont alternativement l'abscisse puis l'ordonnée en commun. Quand plusieurs répondent à ce critère c'est le plus proche à retenir.
Ce constat n'étant pas démontré (bien au-dessus de mes moyens ;-) ) j'ai donc émis une réserve sur des cas plus complexes (?)
eric

PS : sur la feuille le tableau min/max en B16 ne sert à rien. C'est un résidu de ma recherche pour dégager une règle d'ordonnancement de points

 

[CISCO]

Bonjour

2 point consécutifs ont alternativement l'abscisse puis l'ordonnée en commun.
Ce constat n'étant pas démontré ...
eric

Mais c'est bien connu, c'est l'axiome d'Eriiiic...🙂

Merci Eriiiic pour ces explications.

@ plus

 

[Modeste geedee]

Bonsour®

Pour information à qui le souhaite, j'ai la réponse en Python 😉

Très bonne continuation et à bientôt

Ce serait sympathique de partager au moins l'algorithme ...😎

 

[Modeste geedee]

Bonsour®

Pour l'algorithme je me suis basé sur la remarque faite par Modeste : un point présent un nombre pair de fois n'est pas un 'sommet', ce qui se comprend sur la figure car dans ce cas ce sont 2 rectangles alignés. (Edit : ou un point commun à 4 rectangles... En fait ça rappelle le problème des ponts de koenigsbourg)

🙁 ce n'est hélas pas une règle absolue... !
cas de 2 rectangles reliés par un sommet

 

[eriiic]

Oui, je m’apprêtais à mettre en garde dans le cas de rectangle inclus dans un autre.
Pas présent dans son modèle mais comme il a parlé de plan de maison...
Mais dans ce cas on sort du problème de rectangles juxtaposés demandé à l'origine.

Ceci dit je viens d'avoir l'idée d'un autre algorithme beaucoup plus général. Qui traitera, si je ne m'abuse, ces cas.

Je livre déjà l'idée car je n'aurais pas le temps actuellement.
En fait c'est un algorithme de sortie d'un labyrinthe, modifié parce là on est dehors et on ne veut pas y rentrer :