Le calcul d'une surface quelconque d'un ou de plusieurs polygone

0/5 (10 avis)

Snippet vu 2 131 fois - Téléchargée 1 fois

Contenu du snippet

{Un système d'équation et une fonction découverte dans un ancien livre à Beaubourg à Paris}
{Ajout de la possibilité d'obtenir le périmètre le 25.07.2017 by Denis Bertin stéphane}
AJOUT: 14/02/2018 par Cirec
Modifications possibles & attentues ;)

function distance(a,b,x,y:integer): real;
 var da,db: real;
 begin
 da:=longint(a)-longint(x);
 db:=longint(b)-longint(y);
 distance:=sqrt(da*da+db*db);
 end;

function o_tabpt.calcul_surface:longint;
  var i,j,debut,xx,yy,xxx,yyy:integer;
     surface,perimetre,a,b,c,d:real;
      point:tpoint;
      tous_inside,inside:boolean;
      aforme:wformes1.Tforme_dessin;
      sur_forme:u_object.tsur;
  begin
 {nw=1 si un seul polygone,}
 if (tab<>nil) and (nw=1) then
  begin
  surface:=0;
  {writeln('début calcul surface')};
  for i:=1 to pred(npt) do
   begin
   a:=tab^[i].x;
   b:=tab^[succ(i)].x;
   c:=tab^[i].y;
   d:=tab^[succ(i)].y;
   surface:=surface+(a+b)*(c-d);
   {writeln('surface=',surface);}
   {writeln(i,'->',a,',',c);}
   end;
    inc(i); {nombre de coordonnées dans le tableau tab^[i]}
  {writeln(i,'->',b,',',d);}
  //calcul_surface:=relation.log_pouce_to_10mm_carre(abs(surface) / 2);
    calcul_surface:=round(abs(surface)/2);
  {writeln('surface fin=',abs(surface) div 2);}
  end
  else if (tab<>nil) and (nw>=2) then {denis B le 06.02.2018}
    begin
    surface:=0;
    debut:=1;
    inside:=true;
    tous_inside:=false;
    if nw=2 then
      begin
      tous_inside:=true;
      xx:=tab^[1].x;
      yy:=tab^[1].y;
      aforme:=wformes1.Tforme_dessin.Create(xx,yy);
      for i:=succ(debut) to pred(debut+tabw^[1]) do
        begin
        xxx:=tab^[i].x-xx;
        yyy:=tab^[i].y-yy;
        aforme.elements.Add(font_ob1.ligneNode.Create(xxx,yyy));
        end;
      aforme.elements.Add(font_ob1.polynode.Create(0,0));
      aforme.calcul;
      inc(debut,tabw^[2]);
      for i:=succ(debut) to pred(debut+tabw^[2]) do
        begin
        point.x:=tab^[i].x;
        point.y:=tab^[i].y;
        if not aforme.listtabpt.sur(point) then {Denis Bertin Stéphane le 06.02.2018}
          tous_inside:=false;
        end;
      aforme.free;
      end;
    debut:=1;
    for j:=1 to nw do
      begin
      for i:=debut to pred(pred(debut+tabw^[j])) do
        begin
        a:=tab^[i].x;
 b:=tab^[succ(i)].x;
 c:=tab^[i].y;
 d:=tab^[succ(i)].y;
        if tous_inside then
          if inside then
            surface:=surface-(a+b)*(c-d)
          else
            surface:=surface+(a+b)*(c-d)
        else
          surface:=surface+(a+b)*(c-d);
        end; {i}
      inc(debut,tabw^[j]);
      inside:=not(inside);
      end; {j}
     calcul_surface:=round(abs(surface)/2);
    end
 else if (tab<>nil) and (nw=0) then //nw=0 si ligne brisée ouverte (Périmetre)
   begin
    perimetre:=0;
    for i:=1 to pred(npt) do
 begin
 a:=tab^[i].x;
 b:=tab^[succ(i)].x;
 c:=tab^[i].y;
 d:=tab^[succ(i)].y;
 perimetre:=perimetre+distance(round(a),round(c),round(b),round(d));
      end;
    calcul_surface:=round(perimetre);
    end
  else
    calcul_surface:=0;
  end; {o_tabpt.calcul_surface}

A voir également

Ajouter un commentaire

Commentaires

Cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
33 -
Ce code est inutilisable en l'état :
tu utilises des objets et méthodes que tu ne fournis pas
- soit tu corriges cela en apportant des modifications ou en livrant le code manquant.
- soit le code sera supprimé.

Cordialement,
denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
1 -
Si vous voulez savoir ce que je fait, je vous l'explique, j'améliore mon logiciel denis-draw. Exemple hier matin, pour calculer indifféremment, le calcul de la surface, d'un polygone assemblé. Dans la version précédente,seul le calcul des mono-polygone été affectuée.
Dans cette nouvelle version les polygones imbriqué sont aussi pris en compte. En effet un premier test permet tout d'abord de vérifier si il sont juxtaposé et dans ce cas soustraire les polygones ou bien les ajouter si ils sont distincts.
Cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
33 -
qu'est ce que tu ne comprends pas dans :
Ce code est inutilisable en l'état :
tu utilises des objets et méthodes que tu ne fournis pas
- soit tu corriges cela en apportant des modifications ou en livrant le code manquant.
- soit le code sera supprimé.

function o_tabpt.calcul_surface:longint;
  var i,j,debut,xx,yy,xxx,yyy:integer;
     surface,perimetre,a,b,c,d:real;
      point:tpoint;
      tous_inside,inside:boolean;
      aforme:wformes1.Tforme_dessin;// <--- inconnu
      sur_forme:u_object.tsur;// <--- inconnu
  begin
 {nw=1 si un seul polygone,}
 if (tab<>nil) and (nw=1) then// Tab <--- inconnu


il n'y a que ça des objets et méthodes non standard dont tu ne fournis pas le code!!
Du coup personne ne peut tester ce code.

C'est comme si je te disais que j'ai une fonction qui converti un Bitmap gris en couleurs et comme code je te donne ceci:
begin
  ColoriseBitmap(aBitmap: TBitmap);
end;

et je te dis "t'as vu c'est bien hein" !!!
tu ne pourras jamais t'en rendre compte ni tester par toi même ce qui rend ce bout de code totalement inutile à qui que ce soit à part son auteur, ce qui, je te rappelle au passage, n'est pas but du site bien au contraire.

Cordialement.
denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
1 -
Ce bout de code comme tu le dit est désormais intégré au logiciel denis-draw et il fonctionne pour calculer la surface d'un polygone quelconque.
Je suis l'auteur de ce code qui permet désormais d'effectuer un calcul cumulé des surfaces des éléments sélectionnés, j'ai réalisé ce programme et d'autre que moi essaye de se l'attribuer comme tu le devait le comprendre.
Whismeril
Messages postés
13986
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 novembre 2019
319 > denisbertin
Messages postés
197
Date d'inscription
lundi 22 avril 2013
Statut
Membre
Dernière intervention
27 septembre 2019
-
d'autre que moi essaye de se l'attribuer comme tu le devait le comprendre.
si tu postes le code sur internet, tu t'attends à quoi?
La charte est claire sur le sujet, les codes doivent être fonctionnels, et chaque visiteur est en droit de l'utiliser.
Il ne t'appartient d'ailleurs plus en application de la licence creative common http://www.commentcamarche.net/contents/136-informations-de-copyright

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.