Calculer la surface d'une shape sur Excel

Version imprimable

08/03/2016, 13h20
fossi69

Calculer la surface d'une shape sur Excel

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.
08/03/2016, 16h53
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.

1 pièce(s) jointe(s)

bonjour,

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

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
Pièce jointe 203402

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

cordialement

geogeo

09/03/2016, 15h27
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 :roll:
09/03/2016, 19h04
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!
09/03/2016, 20h54
kiki29

Salut, à mettre en application
09/03/2016, 21h17
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.
09/03/2016, 22h23
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.
10/03/2016, 00h12
kiki29

2 pièce(s) jointe(s)

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

1 pièce(s) jointe(s)

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:

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

Pièce jointe 203447

Cordialement

geogeo

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

Code:

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

14/09/2019, 12h31
pascal17430

Divers

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