Discussion :

[fossi69]

Bonjour,
J'ai dessiné un polygone sur excel et je souhaiterais calculer sa surface. Avez-vous une idée du mode opératoire ?
Merci de vos idées.

[Menhir]

Excel (ou VBA) ne sait pas le faire seul. Ce n'est pas une CAO.

VBA te permet de connaitre les points de ton polygone grâce à la propriété Nodes.
Ensuite, c'est une question de mathématiques.

[geogeo70]

bonjour,

Par curiosité je viens de chercher les coordonnées des sommets (nodes) d'un polygone, cela peut te servir à calculer la surface ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub essai()
Dim p As Shape
Dim nodes As ShapeNodes
 
For Each p In Feuil1.Shapes
 
If p.Type = msoFreeform Then Set nodes = p.nodes
Range("A1") = p.Name
For i = 1 To nodes.Count 'sommet 1 = sommet 6 (polygone 5 côtés)
    Cells(i + 1, 1) = "Sommet " & Str(i)
    Cells(i + 1, 2) = nodes(i).Points(1, 1)
    Cells(i + 1, 3) = nodes(i).Points(1, 2)
Next i
Next p
End Sub

mais après il faut calculer la surface!! ...

cordialement

geogeo

[joe.levrai]

Bonjour,

polygone convexe/concave ?

ça ne sera pas la même méthode je pense suivant le cas.
il faudra probablement découper la shape en triangles et additionner les surfaces

[Invité]

Bonjour,
Tu imagine un carré qui couvre le polygone, tu imbriquer deux boucle qui parcours en x,y la surface du carré avec un pas significatif. Le point du carré testé est ou n'est pas dans le polygone alors tu additionne du pas si il est st dedans!

[kiki29]

Salut, à mettre en application

[clementmarcotte]

Bonjour,

Moi, quand je lis tout cela, je me dis que sans boule de cristal, c'est impossible de répondre. Cela veut dire quoi l'aire d'un polygone dans la tête du demandeur ?

Une aire en pixels sur l'écran ?
Une aire en centimètres carrés, en espérant obtenir la même chose à l'impression ? De toutes façons c'est pratiquement impossible d'avoir une correspondance absolue. Cela dépend de trop de facteurs, incluant les résolutions de l'écran et de l'imprimante.
Une aire à l'échelle d'une aire réelle, Dieu sait où ?
Et puis, même s'il trouve les sommets de son polygone, cela ne sert absolument à rien. Tout ce qu'il va obtenir ce sont des longueurs de traits, en pixels peut-être, ou en twips ou en points, je ne sais plus trop. S'il n'a aucune idée à quoi correspond sa longueur transposée en unité de mesure connue, cela ne sert à rien de perdre du temps là-dessus.

C'est une autre histoire de vouloir faire installer une prothèse de la hanche par un microbiologiste.

Il me semble avoir déjà vu quelque part une sorte d'Autocad en logiciel libre.

[Invité]

Oui trouver un algorithme pour modéliser des figure géométriques bonjour.
La solution que j'ai proposé n'est qu'un palliatif pour toutes les raisons que tu évoque.

AutoCad par exemple lui a une propriété qui retour la surface d'un polygone!

Moi j'utilise AutoCAD tous les jours mais je pense que visio le fait, sens pour autant être gratuit il existe dans beaucoup de société et il est relativement facile à ce procurer!

Autodesk il y a déjà quelques temps avait publié une version ultra lite d'AutoCAD gratuit.

[kiki29]

Re, les unités n'ont aucune importance, pour info : un exe autonome sorti des décombres ( Delphi7 )

[geogeo70]

Bonsoir,

J'ai poursuivi mon calcul, je vois que vous avez des idées, moi j'ai utilisé la sommes des aires des trapèzes (projection des côtés sur l'axe des abscisses) ce qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub essai()
 
Dim Nodes As ShapeNodes
Dim Points(10, 1) As Double
Dim i As Integer
Dim Aire As Double
 
' recherche des sommets
Set Nodes = Shapes("poly").Nodes
 
Range("A1") = "poly"
'Affichage des "coordonnées"
For i = 1 To Nodes.Count
    Cells(i + 1, 1) = "Sommet " & Str(i)
    Cells(i + 1, 2) = Nodes(i).Points(1, 1) 'Abscisse
    Cells(i + 1, 3) = Nodes(i).Points(1, 2) 'Ordonnée
Next i
 
'Mise en tableau des coordonnées
For i = 1 To Nodes.Count
    Points(i - 1, 0) = Nodes(i).Points(1, 1)
    Points(i - 1, 1) = Nodes(i).Points(1, 2)
Next i
 
'additions des aires des trapèzes sur chaque vecteur
Aire = 0 '(Grande base+Petite base)*hauteur/2 !!!
For i = 0 To Nodes.Count - 2
    Aire = Aire + (Points(i + 1, 0) - Points(i, 0)) * (Points(i + 1, 1) + Points(i, 1)) / 2
Next i
'les trapèzes blancs sont en moins
Range("K10") = Aire
End Sub

Cordialement

geogeo

[geogeo70]

une petite dernière en créant une fonction appelée sur feuille : airepoly(nom_du_poly),

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function Airepoly(ByVal nom As String) As Double
 
Dim Nodes As ShapeNodes
Dim Points() As Double
Dim i As Integer
 
Application.Volatile
If Not (ActiveSheet.Shapes(nom) Is Nothing) Then
    Set Nodes = ActiveSheet.Shapes(nom).Nodes
    ReDim Points(Nodes.Count, 1)
    'Mise en tableau des coordonnées
    For i = 1 To Nodes.Count
        Points(i - 1, 0) = Nodes(i).Points(1, 1)
        Points(i - 1, 1) = Nodes(i).Points(1, 2)
    Next i
    'additions des aires des trapèzes sur chaque vecteur
    Airepoly = 0 '(Grande base+Petite base)*hauteur/2 !!!
    For i = 0 To Nodes.Count - 2
        Airepoly = Airepoly + (Points(i + 1, 0) - Points(i, 0)) * (Points(i + 1, 1) + Points(i, 1)) / 2
    Next i
    Airepoly = Abs(Airepoly)
Else
    Airepoly = 0
End If
'la feuille n'est pas recalculée lors d'un changement de la forme
'donc F9 pour recalculer
End Function

bonsoir
cordialement
geogeo

[pascal17430]

Bonjour,
Je patine un peu, avez-vous avez le ficher excel complet.
Merci d'avance