Coordonnées de points extérieurs

maxdhavys

XLDnaute Nouveau
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 :?
 

Pièces jointes

  • Test_points_exterieurs.xlsx
    48.7 KB · Affichages: 27
Dernière édition:

maxdhavys

XLDnaute Nouveau
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.
 

eriiic

XLDnaute Barbatruc
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'.
VB:
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
 

Pièces jointes

  • Test_points_exterieurs 1.0.xlsm
    24.9 KB · Affichages: 13

eriiic

XLDnaute Barbatruc
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
VB:
    ' 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
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
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
upload_2018-1-16_14-21-15.png
 

eriiic

XLDnaute Barbatruc
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 :
2018-01-16_14-57-38.png
 

Discussions similaires

Statistiques des forums

Discussions
312 523
Messages
2 089 321
Membres
104 119
dernier inscrit
karbone57