PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Zoom Geometrique en homothetie

http://forums.purebasic.com/french/viewtopic.php?t=18105

Page 1 sur 1

Zoom Geometrique en homothetie

Publié : sam. 30/mai/2020 14:35
par kernadec
bjr à tous
voici une astuce pour faire un zoom géométrique avec le centre du cercle inscrit d'un triangle
à partir de celui ci il suffit pour cela d'augmenter l' échelle des x et y de chaque sommet
maintenant on peut d 'appliquer cela a n'importe quel polygones en décomposant chaque sommet
en un triangle.. zoom avec la molette souris

Cordialement

Code : Tout sélectionner

;###########################################################################################
;###  Zoom geometrique en Homothetie appliquable a tous les polygones en distinguant    ####
;###  3 points ainsi chaque sommet et son précédent et son suivant.  kernadec mai 2020  ####
;###########################################################################################
;https://www.transfernow.net/i0FPax062020
Enumeration
  #windows
  #canvas
  #bouton1
  #bouton2
EndEnumeration

Global axt.d,ayt.d,bxt.d,byt.d,cxt.d,cyt.d,ox.d,oy.d,rayon.d,ang.d,molette.l,ang.d       
Global a_cote_BC.d,b_cote_AC.d,c_cote_AB.d                                     ; Variables Procedure Cercle_Inscrit
Global A_angle.d,B_angle.d,C_angle.d,demi_p.d,aire.d,echelle.d

Global cx.d,cy.d,hx.d,hy.d,z.d  ; Variables Procedure Rayon_hypotenus

ang = 0.001

Procedure.s Cercle_3points(axt.d,ayt.d,bxt.d,byt.d,cxt.d,cyt.d)
  Protected bx1.d,by1.d,bx2.d,by2.d,dx.d,dy.d,dx1.d,dy1.d,dx2.d,dy2.d;,ox.d,oy.d,rayon.d,xyr$
 
  bx1 = (bxt + axt) / 2 : by1 = ((byt + 0.00000001) + ayt) / 2   ;bisectrice (bx1,by1) ; supprime l'infini
  dy1 = bxt - axt : dx1 = - ((byt + 0.00000001) - ayt)           ; supprime l'infini
  bx2 = (cxt + bxt) / 2 : by2 = (cyt + byt) / 2                  ;bisectrice (bx2,by2)
  dy2 = cxt - bxt : dx2 = - (cyt - byt)
  ; centre ox oy au point de croisement des bisectrices
  ox = (by1 * dx1 * dx2 + bx2 * dx1 * dy2 - bx1 * dy1 * dx2 - by2 * dx1 * dx2) / (dx1 * dy2 - dy1 * dx2)
  oy = (ox - bx1) * dy1 / dx1 + by1
  dx = ox - axt : dy = oy - ayt             
  rayon = Sqr(dx * dx + dy * dy)    ; rayon et ox,oy = centre du cercle
 
  ; Debug "ox= " + StrD(ox) + " oy= " + StrD(oy) + " R= "+ StrD(rayon,4)
 
  xyr$ = StrD(ox) + ":" + StrD(oy) + ":" + StrD(rayon) + ":"  ; Formatage retour données ox,oy,rayon
 
  ProcedureReturn xyr$
 
EndProcedure

Procedure.s Cercle_Inscrit(axt.d,ayt.d,bxt.d,byt.d,cxt.d,cyt.d)
  Protected ox.d,oy.d,rayon.d,xyr$
 
  ; longueur des 3 cotes du triangle
  a_cote_BC = Sqr(Pow(Abs(bxt-cxt),2)+Pow(Abs(byt-cyt),2))  ;distance a point_B(xy) <----> point_C(xy)
  b_cote_AC = Sqr(Pow(Abs(axt-cxt),2)+Pow(Abs(ayt-cyt),2))  ;distance b point_A(xy) <----> point_C(xy)
  c_cote_AB = Sqr(Pow(Abs(axt-bxt),2)+Pow(Abs(ayt-byt),2))  ;distance c point_A(xy) <----> point_B(xy)
 
  ; 3 angles du triangle
  A_angle = ACos(((c_cote_AB * c_cote_AB) + (a_cote_BC * a_cote_BC) - (b_cote_AC * b_cote_AC)) / (2 * c_cote_AB * a_cote_BC))
  B_angle = ACos(((a_cote_BC * a_cote_BC) + (b_cote_AC * b_cote_AC) - (c_cote_AB * c_cote_AB)) / (2 * a_cote_BC * b_cote_AC))
  C_angle = ACos(((b_cote_AC * b_cote_AC) + (c_cote_AB * c_cote_AB) - (a_cote_BC * a_cote_BC)) / (2 * b_cote_AC * c_cote_AB))
 
  ; Coordonnees du cercle inscrit
  ox = (c_cote_AB * cxt + a_cote_BC * axt + b_cote_AC * bxt) / (c_cote_AB + a_cote_BC + b_cote_AC)   
  oy = (c_cote_AB * cyt + a_cote_BC * ayt + b_cote_AC * byt) / (c_cote_AB + a_cote_BC + b_cote_AC)
 
 
  demi_p = (a_cote_BC + b_cote_AC + c_cote_AB) / 2    ; calcul du demi périmètre du triangle
  aire = Sqr((demi_p * (demi_p - a_cote_BC) * (demi_p -  b_cote_AC) *  (demi_p - c_cote_AB))) ; aire du triangle
  rayon = aire / demi_p                                                                       ; rayon du cercle inscrit
 
  ; Debug "Demi_p= " + StrD(demi_p,4) + " Aire= " + StrD(demi_p,4) + " R= " + StrD(rayon2,4)
  ; Debug "ox= " + StrD(ox) + " oy= " + StrD(oy) + " R= "+ StrD(rayon,4)
 
  xyr$ = StrD(ox) + ":" + StrD(oy) + ":" + StrD(rayon) + ":"  ; Formatage retour données ox,oy,rayon
 
  ProcedureReturn xyr$
 
  ; calcul du rayon 3 autres possibilités
  ; rayon = a_cote_BC * c_cote_AB * Sin(A_angle) / (a_cote_BC + b_cote_AC + c_cote_AB)
  ; rayon = a_cote_BC * b_cote_AC * Sin(B_angle) / (a_cote_BC + b_cote_AC + c_cote_AB) ;rayon idem
  ; rayon = b_cote_AC * c_cote_AB * Sin(C_angle) / (a_cote_BC + b_cote_AC + c_cote_AB) ;rayon idem
EndProcedure

Procedure.s Rayon_hypotenus(cx.d,cy.d,hx.d,hy.d,z.d)
  Protected cx_x.d ,cy_y.d ,cxcy_xy.d ,xyr$
 
  cx_x = cx - ((cx - hx) * z)
  cy_y = cy - ((cy - hy) * z)
  cxcy_xy = Sqr(Pow(cx_x,2) + Pow(cy_y,2)) * z
 
  xyr$ = StrD(cx_x) + ":" + StrD(cy_y) + ":"          ; Formatage retour données cx_x,cy_y
 
  ProcedureReturn xyr$
 
EndProcedure


Procedure dessin(a.d)
  Protected ox.d ,oy.d ,xy$ ,xyr$
 rayon = 200
  ox = 300
  oy = 300
 
  StartDrawing(CanvasOutput(#canvas))
  Box(0, 0, 600, 600,RGB(255,255,255))
  DrawText(10, 20, Str(GetGadgetAttribute(#canvas,#PB_Canvas_MouseX)),#Black,#White)
  DrawText(10, 40, Str(GetGadgetAttribute(#canvas,#PB_Canvas_MouseY)),#Black,#White)
 
  DrawingMode(#PB_2DDrawing_Outlined)
 
  ; rotation du triangle inscrit
  axt = ox + (rayon * Sin(Radian(0 + ang)))
  ayt = oy + (rayon * Cos(Radian(0 + ang)))
 
  bxt = ox + (rayon * Sin(Radian(120 + ang)))
  byt = oy + (rayon * Cos(Radian(120 + ang)))
 
  cxt = ox + (rayon * Sin(Radian(210 + ang)))
  cyt = oy + (rayon * Cos(Radian(210 + ang)))
 
  xyr$ = Cercle_Inscrit(axt,ayt,bxt,byt,cxt,cyt)
  ox = ValD(StringField(xyr$, 1, ":"))
  oy = ValD(StringField(xyr$, 2, ":"))
  rayon  = ValD(StringField(xyr$, 3, ":"))
 
  Circle(ox,oy, 5,RGB(255,0,0))
  Circle(ox,oy, rayon,RGB(255,0,0))
  Circle(ox,oy,rayon + (rayon * echelle),RGB(255,0,0))  ; zoom cercle rouge
  
  
  Circle(axt, ayt,5,RGB(0,0,0))
  Circle(bxt, byt,5,RGB(0,0,0))
  Circle(cxt, cyt,5,RGB(0,0,0))
 
  ; trace axes du triangle
  LineXY(ox, oy, axt, ayt,RGB(0,0,0) )
  LineXY(ox, oy, cxt, cyt,RGB(0,0,0) )
  LineXY(ox, oy, bxt, byt,RGB(0,0,0) )
 
  ; trace cotés du triangle
  LineXY(bxt, byt, axt, ayt,RGB(0,0,0) )
  LineXY(bxt, byt, cxt, cyt,RGB(0,0,0) )
  LineXY(axt, ayt, cxt, cyt,RGB(0,0,0) )
 
  z = 1 + a
  If z < 0 : z = 0.000001 : EndIf
 
  xy$ = Rayon_hypotenus(ox.d,oy.d,axt.d, ayt.d,z)
  axt = ValD(StringField(xy$, 1, ":"))
  ayt = ValD(StringField(xy$, 2, ":"))
 
  xy$ = Rayon_hypotenus(ox.d,oy.d,bxt.d, byt.d,z)
  bxt = ValD(StringField(xy$, 1, ":"))
  byt = ValD(StringField(xy$, 2, ":"))
 
  xy$ = Rayon_hypotenus(ox.d,oy.d,cxt.d, cyt.d,z)
  cxt = ValD(StringField(xy$, 1, ":"))
  cyt = ValD(StringField(xy$, 2, ":"))
 
  ; trace cotés du triangle
  LineXY(bxt, byt, axt, ayt,RGB(0,0,0) )
  LineXY(bxt, byt, cxt, cyt,RGB(0,0,0) )
  LineXY(axt, ayt, cxt, cyt,RGB(0,0,0) )
 
  ; avec des coordonnées
  ;   axt = 500: ayt = 350        ;point a   
  ;   bxt = 200: byt = 100        ;point b   
  ;   cxt = 100: cyt = 400        ;point c
 
  Circle(axt, ayt,5,RGB(0,0,0))
  Circle(bxt, byt,5,RGB(0,0,0))
  Circle(cxt, cyt,5,RGB(0,0,0))
 
  ; trace cotés du triangle
  LineXY(bxt, byt, axt, ayt,RGB(0,0,0) )
  LineXY(bxt, byt, cxt, cyt,RGB(0,0,0) )
  LineXY(axt, ayt, cxt, cyt,RGB(0,0,0) )
 
  xyr$ = Cercle_3points(axt.d,ayt.d,bxt.d,byt.d,cxt.d,cyt.d)
  ox = ValD(StringField(xyr$, 1, ":"))
  oy = ValD(StringField(xyr$, 2, ":"))
  rayon  = ValD(StringField(xyr$, 3, ":"))
 
  Circle(ox,oy,rayon,RGB(0,0,255))
  Circle(ox,oy,5,RGB(0,0,255))
 
  ; trace axes du triangle
  LineXY(ox, oy, axt, ayt,RGB(0,0,0) )
  LineXY(ox, oy, cxt, cyt,RGB(0,0,0) )
  LineXY(ox, oy, bxt, byt,RGB(0,0,0) )
 
  StopDrawing()
 
EndProcedure

If OpenWindow(#Windows, 0, 0, 620, 620, "Equations Triangles & cercles par kernadec", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 10, 30, 600, 580,#PB_Canvas_ClipMouse  |#PB_Canvas_Keyboard)
  ButtonGadget(#bouton1, 10,  10, 80, 20, "Rotation +")
  ButtonGadget(#bouton2, 90,  10, 80, 20, "Rotation -")
  SetActiveGadget(#Canvas)
 
  Repeat
   
    Event = WaitWindowEvent()
   
    dessin(echelle)
   
    If Event = #PB_Event_Gadget
      If EventType() = #PB_EventType_MouseLeave | #PB_EventType_MouseMove
        SetActiveGadget(#Canvas)
      EndIf
     
      Select EventType()
        Case #PB_EventType_MouseWheel
          molette = GetGadgetAttribute(#Canvas, #PB_Canvas_WheelDelta)
          If molette > 0
            echelle = echelle + 0.05
            dessin(echelle)
          ElseIf molette = < 0
            echelle = echelle - 0.05
            dessin(echelle)
          EndIf
      EndSelect
     
      Select EventGadget()
        Case #bouton1
          ang = Mod(ang + 5,360)
          dessin(echelle)
        Case #bouton2
          ang = Mod(ang - 5,360)
          dessin(echelle)
      EndSelect
     
    EndIf
  Until Event = #PB_Event_CloseWindow
EndIf

Re: Zoom Geometrique en homothetie

Publié : sam. 30/mai/2020 23:19
par Ollivier
Salut Kernadec,

es-tu allergique aux structures ?

C'est sans mal que je te le demande, étant moi-même allergique aux modules...

Par contre, pour les structures, c'est vraiment vraiment très pratique. Le visuel du code aide beaucoup. Là, quand je vois le retour de la procédure qui utilise une chaîne, c'est la pagaille dans ma tête en mode "de tête sans ordi".

En tout cas, ça m'a permis d'aller me rappeler ce qu'était le triangle inscrit, et, par la même (l'un des gros avantages de Google, c'est que depuis le début d'année, ses suggestions Google/Youtube sont beaucoup moins vaseuses) de découvrir le cercle exinscrit !

Re: Zoom Geometrique en homothetie

Publié : dim. 31/mai/2020 8:25
par MLD
@Kernadec
Super
La géométrie c'est ton rayon l’on dirais. :lol: :lol:

Re: Zoom Geometrique en homothetie

Publié : dim. 31/mai/2020 14:42
par kernadec
Bjr Ollivier merci pour le retour
Oui les structures c est sympa, mais ne seraient pas utiles dans ce code.
car le plus simple aurait été d utiliser des variables globales... :D

la commande "ProcedureReturn" n'accepte en retour qu'une variable :?
donc j'aime utiliser ce mode de retour de procédure avec un transport
concaténé en string de plusieurs résultats, bien sur c est pas commun. :mrgreen: :mrgreen:

comme c'est original que personne ne le fasse, je vais continuer comme ça
Car toujours labourer dans le même sillon n est pas mon truc
car la création implique de combiner autrement les leçons reçues
c'est comme cela qu'on passe d’interprète à compositeur. :wink:

;@fred Quand on utilise Debug et sa concaténation numériques strings
;il serait sympa quand utilise StrD() que la ligne conserve aussi son formatage défini
et aussi le souhait d'avoir une commande DEC <> DMS

Code : Tout sélectionner

Debug StrD(Sqr(2),4) + " : " + Sqr(3) + " : " + Sqr(5)

@MLD merci, heureux que ça te plaise
oui la géométrie j'aime beaucoup, j'ai passé 35 ans de ma vie derrière des théodolites :)

pour le fun je vous met deux dessin qui montre l interet de l'orient pour ces équations
au cours des années 1986 j'avais acheté le gfabasic pour atari
et j'avais ecrit un programme avec l’équation du cercle par 3 points
pour travailler sur la relation sinus, cosinus, tangente et rechercher le centre pour un angle donné
après coup je m étais rendu compte que le dessin de tous les centre représentait l architecture des
toits des temple bouddhiste je vous met des images du dessin et d'un temple

Image
Image

je vous post aussi un exemple de dessin pour utiliser cette fonction
zoom avec des figures polygonales peu importe le nombres de cotés
il suffit de les traiter 3 par 3.. exemple en image

Cordialement

Image

voici les dessins format PDF ici : https://jmp.sh/huuTkto

ps: j'ai oublié de vous parler de cette coïncidence si quand on prend un angle de 45degre sinus cosinus tangente
en prenant le centre maxi obtenu et les deux centre maxi des sinus et cosinus
et qu' on joint les trois cotés du triangle nous somme dans les proportions de la pyramides
74 degre en haut et 2 fois 53 degres à la base étonnant et si on rabat les triangle au centre
nous obtenons une pyramide et comme elle s'est dégradée dans le temps car son revêtement
s'est affaissé mystère... l'angle supérieur du triangle à l heure actuel et de 76 degrés
l'érosion a pu lui faire perdre 2 degres en 6000 ans et plus
car je pense qu'elle on été construite au passage des trois étoile alignée sur l'équateur du baudrier d’Orion
au passage du point vernal dans le parcours des étoiles avec la précession des équinoxes donc a peu près 6000ans
pour le sphinx et l'étoile Régulus du signe du lion il faut compte 12000ans pour qu'il passe au point vernal
donc c'est probablement son age.... mais ce ne sont probablement que des coïncidences :mrgreen: :mrgreen:

Re: Zoom Geometrique en homothetie

Publié : dim. 31/mai/2020 22:53
par Ollivier
L'image 1/3 ne s'affiche pas. (dessin comparatif)

Re: Zoom Geometrique en homothetie

Publié : lun. 01/juin/2020 6:46
par kernadec
bjr Ollivier
merci pour l'info, j ai changer le format des images de png à jpg :?:
au cas ou j'ai mis une autre adresse avec les fichiers en pdf pour la précisions des dessins c'est top
https://jmp.sh/huuTkto

j'utilise Microstation pour les dessins géométriques logiciel ou j'ai reçu une formation en 1995
j'ai une version démo, mais elle a une petite contrainte tout les 15 minutes il se ferme
mais comme il sauvegarde dans l'instant chaque manips, alors pas de problème
tu le relance en un clin d' oeil avec ton dessin et en ayant rien perdu de ton travail,
perso je le trouve top mieux qu' Autocad
https://bentley-microstation.software.i ... A9charger/

car moins procédurier exemple tu ouvre un espace de travail tu trace un trait peu importe la couleur
en cour il le trace, sur Autocad il va commencer par te demander la couleur, le style, l’épaisseur,
etc.. c'est chiant a moins de l'utiliser avec un menu tablette sinon c'est trop chiant comme approche.

Cordialement

Re: Zoom Geometrique en homothetie

Publié : lun. 01/juin/2020 19:41
par Ollivier
Ça y est ! L'image est visible et, effectivement, il y a coïncidence.

Une autre technique pour sortir plusieurs paramètres d'une procédure : les pointeurs.

Code : Tout sélectionner

Procedure DesktopExamine(*W.Integer, *H.Integer)
   ExamineDesktops()
   *W\I = DesktopWidth(0)
   *H\I = DesktopHeight(0)
EndProcedure


Define W, H
DesktopExamine(@W, @H)

Debug W
Debug H
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru