XL 2019 Fusion de formes libres

[Softmama]

Bonjour à tous,

Je bute sur un problème simple :
A partir de 2 formes libres aléatoires de type Polygones FreeFormBuilder (en bleu), réaliser une nouvelle forme libre (jaune) qui épouse les contours des 2 bleues si les bleues se superposent.

Je parviens à récupérer les coordonnées des sommets de chaque forme libre bleue mais ne parviens pas à réaliser à tous les coups le résultat voulu.
Je joins un fichier exemple qui montre comment je m'y suis pris.

Ensuite si quelqu'un trouve la solution et qu'il peut l'étendre à plus de 2 formes bleues juxtaposées qui produisent une forme jaune, je suis preneur

Merci pour votre aide, toute piste est la bienvenue
(même si je sais et je suis d'accord, Excel n'est pas adapté pour traiter des objets graphiques, mais bon...)

 

[Softmama]

Bonjour,

Pour ceux que ça intéresse, j'ai trouvé une piste que je vais développer. Si le point est dans la forme délimitée, la somme des angles de ce point avec les 2 sommets adjacents de la forme délimitée fait 360° (un cercle complet) et le nombre de segments de la forme délimitée traversés par une demi droite partant de ce point est impaire. Si l'une ou l'autre de ces conditions n'est pas vérifiée, alors c'est que le point n'est pas dans la forme délimitée.

Illustration du sommet de la forme violette qui appartient bien à la forme bleue, car la somme des angles et bien 360° et la demie droite rouge traverse une seule fois la forme bleue :

Cela devrait régler mon problème.

 

[ALS35]

Bonjour,
Si ton but est de faire du vba pour créer la forme, très bien.
Si tu veux juste obtenir une nouvelle forme à partir des deux autres, passe par Powerpoint qui possède les outils pour combiner, soustraire, intersecter, .. et tu recopies dans Excel ensuite.
Cordialement

 

[Softmama]

Bonjour,

Merci pour ce conseil qui me semble intéressant.
En effet, le Selection.Join (Visio) que propose Powerpoint semble remplir directement ce que je cherche à faire, lorsque je le fais à la main depuis la diapo.
Seulement, y a-t-il une façon d'automatiser la manipulation, car je parviens juste à sélectionner les Shapes du document par ActivePresentation.Slides(1).Shapes.SelectAll, puis je bloque pour utiliser par macro l'outil d'Union :
Application.ActiveWindow.Selection.Join ne fonctionne pas
ni Selection.join ni quoi que ce soit que j'ai pu essayer (.combine ...)
Et évidemment il n'y a pas d'enregistreur de macro dans Powerpoint pour se dépatouiller.

 

[ALS35]

Re,
Désolé, perso je n'ai pas les compétences pour ça.
Bonne chance

 

[patricktoulon]

Bonsoir
selon moi la solution est simple très simple même
tu a 2 polygones groupés
chacun fait x de large et y de haut (en fait un rectangle(4 coté)(même si il y a des parties vides)
si jajoute le width d'une au width de l'autre j'obtiens la largeur des deux
si j'ajoute le height d'une au height de l'autre j'obtiens la hauteur des deux
si la largeur ou hauteur de ce groupe et différente des ces deux dimensions ils se croisent forcement quelque part
celà en intégrant une marge d'erreur pondéré (vu que c'est des polygones quelconques)

tu n'aura pas trop de mal a en faire la formulation par vba je pense
parce que meme avec la formule du cercle (un tour de 360°(vu que c'est des polygones)) tu risque de passer à coté ou dedans alors que c'est pas le cas

il y aurait bien aussi avec l'api getpixel dans une boucle mais ce serait très long

 

[Softmama]

Bonsoir Patricktoulon,

Merci pour ta réponse.
En effet, c'est assez simple pour le cas que tu présentes qui est un cas particulier.
Le problème reste entier lorsque le .Width de la forme groupée est inférieure à la somme de chaque forme qui la compose : impossible de savoir facilement si les formes se chevauchent : cette forme par exemple le montre :

J'ai un peu avancé avec la technique du 360° et ne suis plus limité à 2 formes. Par contre je n'ai pas exactement le résultat escompté, car il manque les points d'intersection entre les formes, mais globalement, je pense que je vais me contenter de ce résultat : cf. fichier en PJ avec 3 formes libres dessinées.

 

[patricktoulon]

re
moi je suis en train d'essayer une autre approche
puisque l'on peut connaître les coordonnée des points qui forme les polygones
je fait un getpixel dessus pour voir si la couleur est la bonne en changeant provisoirement la couleur de la formes 2
ce qui pour moi serait la meilleure solution mais j'avoue que ca ne va pas comme je veux

 

[p56]

Bonjour à tous,
Exercice amusant, alors voici ou j'en suis ce midi : pour l'instant j'arrive à déterminer les points d'intersection entre 2 formes quelque soient leurs positions respectives ...
Ici les points des 2 shapes en vert et en jaune et en rouge les intersections

 

[patricktoulon]

re
Bonjour @p56
moi de dis respect ça a l'air plus propre comme travail
on aimerait bien le fichier je pense

 

[Softmama]

Bonjour p56,

En effet, cela est prometteur.
Je suis également curieux de voir un fichier pour me plonger dedans.
Par contre, il ne semble pas encore gérer si les points verts ou jaunes appartiennent ou non à l'autre forme, chose qui fonctionne bien sur mon fichier (j'ai fait une petite modif sur le fichier posté hier pour gérer des vecteurs orientés, et obtenir des angles négatifs, car dans certains cas, la somme des angles différait de 360° lorsque l'orientation des vecteurs changeaient de sens.

Je pense donc qu'il y a du bon dans chaque solution présentée, qui mises bout à bout devraient fournir un résultat intéressant.
Ensuite restera à trouver la règle qui permet de relier tous les points retenus dans le bon ordre, ce que j'ai codé donne des résultats inappropriés dans quelques rares cas assez singuliers ; j'essaie d'améliorer le truc.

Merci en tout cas pour cette contribution,

 

[patricktoulon]

les points dans le bon ordre sont dans le sens inverse de la montre visiblement
d'après mon analyse
pour deux shapes ont prend
le 1 ,2 etc.de la shape1 jusqu'a intersection de la shapes2
parti de la on prend celui qui est plus grand que l'intersection (c'est lui le premier point a prendre de la shapes2
on continu jusqu'a la 2d intersection qui sera le dernier point formant une figure avec les deux shapes
moi aussi j'attends avec impatience le fichier de @P56(même en l'état)

 

[p56]

Bonsoir à tous,

Bon voici mon fichier en mode "friche industrielle" mais avec numérotation des points.
Ce fichier combine la méthode des angles de @Softmama avec ma méthode des segments et intersections potentielles.
Dans certains cas de figure, même si certains points "internes" sont éliminés, c'est pas toujours bien résolu. En fait c'est très loin d'être aboutit ...
Exemple ici, je ne sais pas comment ordonner les points pour tenir compte du "trou" à dessiner :

Et de façon générale, pour ce soir je ne sais pas comment ordonner les points.
A suivre ... peut-être?

P.

 

[mromain]

Bonjour à tous,

Ci-dessous une solution basée sur la proposition d’ALS35 d’utiliser les outils de PowerPoint.
Au passage, merci pour l’astuce, je ne connaissais pas ces outils .

La fonction suivante MergeShapes permet de fusionner plusieurs formes au sein d’une feuille Excel.
Son paramètre MergeMode permet de définir le type de fusion.
Elle garde les formes d’origine et en crée une nouvelle : le résultat de la fusion.

'Nécessite d'activer la référence 'Microsoft PowerPoint XX.0 Object Library'
Function MergeShapes(shpRange As Excel.ShapeRange, Optional MergeMode As Office.MsoMergeCmd = Office.MsoMergeCmd.msoMergeUnion) As Excel.Shape
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim groupTopSheet As Single
Dim groupLeftSheet As Single
Dim groupTopSlide As Single
Dim groupLeftSlide As Single
Dim i As Long

    On Error GoTo GestErr
    
    'créer une nouvelle instance de PowerPoint
    Set pptApp = CreateObject("PowerPoint.Application")
    
    'créer une nouvelle présentation et un slide vide
    Set pptPres = pptApp.Presentations.Add
    Set pptSlide = pptPres.Slides.Add(1, 12)    '12 = ppLayoutBlank
    
    'initialiser la position (top/left) du groupe de forme sur la feuille excel
    groupTopSheet = shpRange(1).Top
    groupLeftSheet = shpRange(1).Left
    
    With pptSlide
        'boucler sur toutes les formes à grouper
        For i = 1 To shpRange.Count
            'copier la forme sur le slide
            shpRange(i).Copy
            .Shapes.Paste
            'repositionner la forme par rapport à la première / mémoriser les position sur le slide
            If i = 1 Then
                groupTopSlide = .Shapes(i).Top
                groupLeftSlide = .Shapes(i).Left
            Else
                .Shapes(i).Top = .Shapes(1).Top + shpRange(i).Top - shpRange(1).Top
                .Shapes(i).Left = .Shapes(1).Left + shpRange(i).Left - shpRange(1).Left
                If .Shapes(i).Top < groupTopSlide Then groupTopSlide = .Shapes(i).Top
                If .Shapes(i).Left < groupLeftSlide Then groupLeftSlide = .Shapes(i).Left
            End If
            'recalculer la position du groupe de forme sur la feuille excel
            If shpRange(i).Top < groupTopSheet Then groupTopSheet = shpRange(i).Top
            If shpRange(i).Left < groupLeftSheet Then groupLeftSheet = shpRange(i).Left
        Next i
        
        'grouper les formes
        groupTopSheet = groupTopSheet - groupTopSlide
        groupLeftSheet = groupLeftSheet - groupLeftSlide
        .Shapes.Range.MergeShapes MergeMode
        
        'copier la/les forme(s) résultante(s) de l'opération de Merge
        If .Shapes.Count > 1 Then .Shapes.Range.Group
        groupTopSheet = groupTopSheet + .Shapes(1).Top
        groupLeftSheet = groupLeftSheet + .Shapes(1).Left
        .Shapes(1).Copy
    End With
    
    'copier la forme sur la feuille excel
    With shpRange.Parent
        .Paste
        Set MergeShapes = .Shapes(.Shapes.Count)
    End With
    
    'repositionner la forme
    MergeShapes.Top = groupTopSheet
    MergeShapes.Left = groupLeftSheet
    
GestFin:
    On Error Resume Next
    Set pptSlide = Nothing
    pptPres.Close
    Set pptPres = Nothing
    pptApp.Quit
    Set pptApp = Nothing
    Exit Function
    
GestErr:
    Stop    'erreur à creuser
    GoTo GestFin
End Function

La fonction est loin d’être parfaite car :

• de par son fonctionnement, elle est "lourde" : elle crée une présentation PowerPoint, y copie les formes pour effectuer l’opération de fusion et copie l forme résultat dans Excel ;
• elle nécessite d'activer la référence Microsoft PowerPoint XX.0 Object Library pour fonctionner ;
• la gestion d’erreur n’est pas complétée.

Ci-dessous un code exemple qui fusionne les formes Forme 1 et Forme 2 de la feuille active :

Sub Test()
Dim shpRange As Excel.ShapeRange
Dim shpMerge As Excel.Shape
    
    'récupérer les formes à grouper
    Set shpRange = ActiveSheet.Shapes.Range(Array("Forme 1", "Forme 2"))
    
    'créer la forme groupée et la renommer
    Set shpMerge = MergeShapes(shpRange, msoMergeUnion)
    shpMerge.Name = "Shp_Union"
    
    Set shpMerge = Nothing
    Set shpRange = Nothing
End Sub

Ci-joint un exemple présentant les cinq modes de fusion.

A+

 

[Katido]

Bonjour,

Un polygone à n côtés peut être découpé en n + 2 triangles.
Pour qu'un point soit intérieur au polygone, il faut et il suffit qu'il soit intérieur à l'un des triangles (attention de bien choisir les triangles si le polygone n'est pas convexe).

Et pour qu'un point M soit intérieur au triangle ABC, il faut et il suffit que les 3 inégalités suivantes soient vérifiées :
(AB ᴧ AM).(CA ᴧ AM) ≥ 0
(BC ᴧ BM).(AB ᴧ BM) ≥ 0
(CA ᴧ CM).(BC ᴧ CM) ≥ 0
Il s'agit bien sûr des vecteurs AB, BC, etc. L'opérateur ᴧ est le produit vectoriel et l'opérateur . est le produit scalaire.

=============================================================

Mais ceci ne suffit pas à répondre au besoin initial qui est de réaliser l'union des polygones.

Pour cela, une piste consiste à déterminer si chaque côté du polygone A possède une intersection avec chaque côté du polygone B. Si on trouve des points d'intersection, les sommets de la forme intérieure sont constitués de ces points ainsi que des éventuels sommets de B intérieurs à A et des éventuels sommets de A intérieurs à B

Pour déterminer le point d'intersection de 2 segments A et B (s'il existe), on calcule les pentes pA et pB si A et B ne sont pas verticales. On calcule aussi qA et qB qui définissent les équations y = p x + q des droites portant A et B
- Si les pentes sont égales A et B :
- Si qA et qB sont différents, A et B sont parallèles et n'ont pas d'intersection
- Si qA et qB sont égaux, A et B sont sur la même droite et il faut analyser les extrémités des 2 segments qui peuvent avoir ou non une partie commune
- Si les pentes sont différentes. les droites qui portent les segments A et B se coupent en M de coordonnées x = (qA - qB)/(pB - pA) et y = pA x + qA. Pour que les segments se coupent, il faut que (x - xA1)/(xA2 - xA1) et (x - xB1)/(xB2 - xB1) soient tous deux >=0 et <=1.
Attention au cas particulier des segments verticaux (x1 = x2)
Maintenant qu'on connait les sommets du polygone intersection, il faut les mettre dans le bon ordre, et construire le polygone union.

C'est encore du travail.