programme topo pour voyage 200 - Page 1

Salut, je cherche des programmes de topo pour ma voyage 200. Je suis preneur de tout
Merci

Salut, je suis dans le même cas et je n'ai toujours pas trouvé grand chose. J'ai donc commencé à faire quelques fonctions, mais je n'en suis qu'au début, si des personnes sont intéréssée pour me donner un cou^de main, des idées etc... Je suis à votre écoutes. Pour le moment j'ai fais une petite fonction sur la résolution des triangles. Je ne connais que le TiBasic, pas trop le temps pour le moment d'étudier d'autre langage de programmation.

salut voici quelque programme en TiBasic pour la topo,
Le premier permet de calculer a partir de G et Dh les coordonnées X Y des points (une petite modif à faire pour calculer Z) si quelqu'un veut bien donner un coup de main merci :
Il sufit de rentrer une matrice tel que la première ligne soit le nom des points, la seconde les distance horizontale, et la 3émé les gisements (matin,xst,yst,g0) Func Local i,matout  newMat(5,dim(matin)[2])matout  For i,1,dim(matin)[2]   If matin[2,i]+g0>2*cos´(­1) Then     matin[2,i]+g0-2*cos´(­1)matout[1,i]   ElseIf matin[2,i]+g0<0 Then     matin[2,i]+g0+2*cos´(­1)matout[1,i]   Else    matin[2,i]+g0matout[1,i]   EndIf  EndFor  matin[3] .* listmat(sin(matlist(matout[1])))matout[2]  matin[3] .* listmat(cos(matlist(matout[1])))matout[3]  listmat(matlist(matout[2])+xst)matout[4]  listmat(matlist(matout[3])+yst)matout[5]  Return augment(matin;matout) EndFunc
La fonction suivante permet de comparer menbre à menmbre les éléments d'une matrice ou d'une liste (fonction utiliser dans résoutri) (list1,list2) Func  Local i  If getType(list1)="LIST" or getType(list1)="MAT" Then    If (getType(list1)getType(list2)) or (dim(list1)dim(list2))    Return false   If getType(list1)="MAT" Then     matlist(list1)list1    matlist(list2)list2   EndIf   For i,1,dim(list1)    If list1[i]list2[i]     Return false   EndFor    Return true  Else   If list1list2    Return false   Return true  EndIf EndFunc
La fonction suivantes permet de resoudre les triangles en donnant la valeur des angles ou des cotés : (lvar,strigo) Func  Local mtresult,mtdist,mtang,ltype,ltdist, ltang,ldist,lang,lresult,n,tang,r,p,i,t  {1,1,1,1,1,1}ltype  {0,0}lresult  0p  0r  if GetMode("angle")="RADIAN"   Œtang  if GetMode("angle")="DEGREE"   180tang  If GetMode("angle")="GRADIAN"   200tang  For i,1,6   lvar[i]t   if getType(t)="VAR" or lvar[i]=0    0ltype[i]  EndFor  sum(ltype)n  left(ltype,3)ltdist  left(lvar,3)ldist  right(ltype,3)ltang  right(lvar,3)lang  If strigo=1 then   {ltdist[1],ltdist[3],ltdist[2]}ltdist   {ltang[1],ltang[3],ltang[2]}ltang   {lang[1],lang[3],lang[2]}lang   {ldist[1],ldist[3],ldist[2]}ldist  EndIf  If n<3 then   listmat(augment(lvar,lresult))mtresult   return augment(mtresult;mtresult)  ElseIf n=3 then   ©Cas où 3 ang connus   If sum(ltdist)=0 then    kldist[1]    ldist[1]*sin(lang[2])/sin(lang[1])ldist[2]    ldist[1]*sin(lang[3])/sin(lang[1])ldist[3]    1/2*ldist[1]^2*sin(lang[2])*sin(lang[3])/sin(lang[1])lresult[1]    0lresult[2]    listmat(augment(augment(ldist,lang),lresult))mtresult    return augment(mtresult;mtresult)   EndIf   ©Cas où 3 dist connues   If sum(ltdist)=3 then    cos´((ldist[1]^2-(ldist[2]^2+ldist[3]^2))/(­2*ldist[2]*ldist[3]))lang[1]    cos´((ldist[2]^2-(ldist[3]^2+ldist[1]^2))/(­2*ldist[3]*ldist[1]))lang[2]    cos´((ldist[3]^2-(ldist[1]^2+ldist[2]^2))/(­2*ldist[1]*ldist[2]))lang[3]    1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]    sum(lang)/tanglresult[2]    listmat(augment(augment(ldist,lang),lresult))mtresult    return augment(mtresult;mtresult)   EndIf   ©Cas où 1 ang 2 dist adjacentes   If lmcomp(exact(ltang and ltdist),exact({0,0,0}))=true and sum(ltdist)=2 then    while lmcomp(exact(ltang),exact({1,0,0}))=false     rotate(ltang,1)ltang     r+1r    Endwhile    rotate(ldist,r)ldist    rotate(lang,r)lang    ¨(ldist[2]^2+ldist[3]^2-2*ldist[2]*ldist[3]*cos(lang[1]))ldist[1]    sin´(ldist[2]/ldist[1]*sin(lang[1]))lang[2]    sin´(ldist[3]/ldist[1]*sin(lang[1]))lang[3]    1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]    3*(ldist[2]*ldist[3]*sin(lang[1]))/(ldist[2]*ldist[3]*sin(lang[1])+ldist[3]*ldist[1]*sin(lang[2])+ldist[1]*ldist[2]*sin(lang[3]))lresult[2]    rotate(ltang,­r)ltang    rotate(ldist,­r)ldist    rotate(lang,­r)lang    listmat(augment(augment(ldist,lang),lresult))mtresult    return augment(mtresult;mtresult)   EndIf    © Cas où 1 ang 1dist adj 1dist opp   If lmcomp(exact(ltang and ltdist),exact(ltang))=true  and sum(ltdist)=2Then     while lmcomp(exact(ltang),exact({1,0,0}))=false   ©boucle     rotate(ltang,1)ltang                            ©de permutation     r+1r                                            ©des données    Endwhile    rotate(ldist,r)ldist    rotate(lang,r)lang    rotate(ltdist,r)ltdist    If lmcomp(ltdist,{1,1,0})=true ©tion entre côté dte     {ldist[1],ldist[3],ldist[2]}ldist ©et côté gche    sin´(ldist[3]/ldist[1]*sin(lang[1]))lang[3]    tang-(lang[3]+lang[1])lang[2]    ldist[1]*(sin(lang[2])/sin(lang[1]))ldist[2]    1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]    ldist[1]*sin(lang[3])/(ldist[3]*sin(lang[1]))lresult[2]    If lmcomp(ltdist,{1,1,0})=true then     {ldist[1],ldist[3],ldist[2]}ldist     {lang[1],lang[3],lang[2]}lang     EndIf    rotate(ldist,­r)ldist    rotate(lang,­r)lang    listmat(augment(augment(ldist,lang),lresult))mtresult    rotate(ldist,r)ldist    rotate(lang,r)lang    If lmcomp(ltdist,{1,1,0})=true     {ldist[1],ldist[3],ldist[2]}ldist    tang-sin´(ldist[3]/ldist[1]*sin(lang[1]))lang[3]    tang-(lang[3]+lang[1])lang[2]    ldist[1]*(sin(lang[2])/sin(lang[1]))ldist[2]    1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]    ldist[1]*sin(lang[3])/(ldist[3]*sin(lang[1]))lresult[2]    If lmcomp(ltdist,{1,1,0})=true then     {ldist[1],ldist[3],ldist[2]}ldist     {lang[1],lang[3],lang[2]}lang     EndIf    rotate(ldist,­r)ldist    rotate(lang,­r)lang    return augment(mtresult;listmat(augment(augment(ldist,lang),lresult)))     EndIf   ©reste les cas 2 ang 1 dist   while lmcomp(exact(ltang),exact({0,1,1}))=false    rotate(ltang,1)ltang    r+1r   Endwhile   rotate(lang,r)lang   tang-(lang[2]+lang[3])lang[1]   rotate(lang,­r)lang   0r   while lmcomp(exact(ltdist),exact({1,0,0}))=false    rotate(ltdist,1)ltdist    r+1r   Endwhile   rotate(lang,r)lang   rotate(ldist,r)ldist   ldist[1]*sin(lang[2])/sin(lang[1])ldist[2]   ldist[1]*sin(lang[3])/sin(lang[1])ldist[3]   1/2*ldist[1]^2*(sin(lang[2])*sin(lang[3]))/sin(lang[1])lresult[1]   (1/2*ldist[1]^2*(sin(lang[2])*sin(lang[3]))/sin(lang[1]))/(1/2*ldist[2]*ldist[3]*sin(lang[1]))lresult[2]   rotate(ldist,­r)ldist   rotate(lang,­r)lang   listmat(augment(augment(ldist,lang),lresult))mtresult   return augment(mtresult;mtresult)    ElseIf n>3 then ©cas de surabondance   If sum(ltang)=3 then     If sum(ltdist)=1 then ©3ang 1dist     while lmcomp(exact(ltdist),exact({1,0,0}))=false      rotate(ltdist,1)ltdist      r+1r     Endwhile     rotate(lang,r)lang     rotate(ldist,r)ldist     ldist[1]*sin(lang[2])/sin(lang[1])ldist[2]     ldist[1]*sin(lang[3])/sin(lang[1])ldist[3]     1/2*ldist[1]^2*(sin(lang[2])*sin(lang[3]))/sin(lang[1])lresult[1]     1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[2]     rotate(ldist,­r)ldist     rotate(lang,­r)lang     listmat(augment(augment(ldist,lang),lresult))mtresult     return augment(mtresult;mtresult)          EndIf    If sum(ltdist)=2 then ©3ang 2dist     while lmcomp(exact(ltdist),exact({1,1,0}))=false      rotate(ltdist,1)ltdist      r+1r     Endwhile     rotate(ldist,r)ldist     rotate(lang,r)lang     ldist[1]*sin(lang[3])/sin(lang[1])ldist[3]     1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]     (ldist[1]/ldist[2])*(sin(lang[2])/sin(lang[1]))lresult[2]     rotate(ldist,­r)ldist     rotate(lang,­r)lang     listmat(augment(augment(ldist,lang),lresult))mtresult     return augment(mtresult;mtresult)        EndIf    if sum(ltdist)=3 then ©3ang 3dist     If ldist[1]/sin(lang[1])=ldist[2]/sin(lang[2]) and ldist[1]/sin(lang[1])=ldist[3]/sin(lang[3]) and ldist[2]/sin(lang[2])=ldist[3]/sin(lang[3]) then      1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]      1lresult[2]      listmat(augment(augment(ldist,lang),lresult))mtresult      return augment(mtresult;mtresult)         Else      [0,0,0,0,0,0,0,0]mtresult      if ldist[2]^2+ldist[3]^2-2*ldist[2]*ldist[3]*cos(lang[1])œ0 or ldist[3]^2+ldist[1]^2-2*ldist[3]*ldist[1]*cos(lang[2])œ0 orldist[1]^2+ldist[2]^2-2*ldist[1]*ldist[2]*cos(lang[3])œ0 or abs((ldist[1]^2-(ldist[2]^2+ldist[3]^2))/(­2*ldist[2]*ldist[3]))ž1 or abs((ldist[2]^2-(ldist[3]^2+ldist[1]^2))/(­2*ldist[3]*ldist[1]))ž1 or abs((ldist[3]^2-(ldist[1]^2+ldist[2]^2))/(­2*ldist[1]*ldist[2]))ž1       return augment(listmat(augment(lvar,{1/2*lvar[2]*lvar[3]*sin(lvar[4]),0}));mtresult)         lang+(tang-sum(lang))/3lang ©compensation des erreures angulaire      ¨(ldist[2]^2+ldist[3]^2-2*ldist[2]*ldist[3]*cos(lang[1]))ldist[1]      ¨(ldist[3]^2+ldist[1]^2-2*ldist[3]*ldist[1]*cos(lang[2]))ldist[2]      ¨(ldist[1]^2+ldist[2]^2-2*ldist[1]*ldist[2]*cos(lang[3]))ldist[3]      cos´((ldist[1]^2-(ldist[2]^2+ldist[3]^2))/(­2*ldist[2]*ldist[3]))lang[1]      cos´((ldist[2]^2-(ldist[3]^2+ldist[1]^2))/(­2*ldist[3]*ldist[1]))lang[2]      cos´((ldist[3]^2-(ldist[1]^2+ldist[2]^2))/(­2*ldist[1]*ldist[2]))lang[3]      1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]      1lresult[2]      listmat(augment(augment(ldist,lang),lresult))mtresult      return augment(listmat(augment(lvar,{1/2*lvar[2]*lvar[3]*sin(lvar[4]),0}));mtresult)          EndIf    EndIf   EndIf   If sum(ltdist)=3 then     If sum(ltang)=1 then ©1ang 3dist     while lmcomp(exact(ltang),exact({1,0,0}))=false      rotate(ltang,1)ltang      r+1r     Endwhile     rotate(lang,r)lang     rotate(ldist,r)ldist     sin´(ldist[2]/ldist[1]*sin(lang[1]))lang[2]     sin´(ldist[3]/ldist[1]*sin(lang[1]))lang[3]        1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]     ((ldist[2]/sin(lang[2]))/(ldist[1]/sin(lang[1]))+(ldist[3]/sin(lang[3]))/(ldist[1]/sin(lang[1])))/2lresult[2]       rotate(ldist,­r)ldist     rotate(lang,­r)lang     listmat(augment(augment(ldist,lang),lresult))mtresult     return augment(mtresult;mtresult)        EndIf    If sum(ltang)=2 then ©2ang 3dist     while lmcomp(exact(ltang),exact({1,1,0}))=false      rotate(ltang,1)ltang      r+1r     Endwhile     rotate(lang,r)lang     rotate(ldist,r)ldist     tang-(lang[1]+lang[2])lang[3]     1/2*ldist[2]*ldist[3]*sin(lang[1])lresult[1]     lang[3]/sin´(ldist[3]/ldist[1]*sin(lang[1]))lresult[2]       rotate(ldist,­r)ldist     rotate(lang,­r)lang     listmat(augment(augment(ldist,lang),lresult))mtresult     return augment(mtresult;mtresult)         EndIf   EndIf   If sum(ltdist)=2 and sum(ltang)=2 Then    while lmcomp(exact(ltang),exact({0,1,1}))=false     rotate(ltang,1)ltang     r+1r    Endwhile    rotate(lang,r)lang    tang-(lang[2]+lang[3])lang[1]    rotate(lang,­r)lang    0r    while lmcomp(exact(ltdist),exact({1,1,0}))=false     rotate(ltdist,1)ltdist     r+1r    Endwhile    rotate(lang,r)lang    rotate(ldist,r)ldist    ldist[1]*sin(lang[3])/sin(lang[1])ldist[3]    1/2*ldist[1]^2*(sin(lang[2])*sin(lang[3]))/sin(lang[1])lresult[1]    (1/2*ldist[1]^2*(sin(lang[2])*sin(lang[3]))/sin(lang[1]))/(1/2*ldist[2]*ldist[3]*sin(lang[1]))lresult[2]    rotate(ldist,­r)ldist    rotate(lang,­r)lang    listmat(augment(augment(ldist,lang),lresult))mtresult    return augment(mtresult;mtresult)       EndIf  EndIf Endfunc
La fonction suivante permet de convertir les coordonnées polaire en coordonnées rectangulaire (r,g) Func If r=0 Then   Return {0,0} Else  Return {r*sin(g),r*cos(g)} EndIf EndFunc
La fonction reciproque (x,y) Func Local d,g ¨(x^2+y^2)d If x=0 or y=0 Then   If x=0 and y=0 Then    Return {0,0}  ElseIf x=0 and y0 Then    If y>0 Then     Return {d,0}   Else    Return {d,cos´(­1)}   EndIf  ElseIf y=0 and x0 Then    If x>0 Then     Return {d,cos´(­1)/2}   Else    Return {d,3*cos´(­1)/2}   EndIf  EndIf Else  If abs(x)œabs(y) Then    tan´(x/y)g   If y>0 Then     If g<0 Then      2*cos´(­1)+gg    EndIf   Else    cos´(­1)+gg   EndIf  Else   tan´(y/x)g   If x>0 Then     cos´(­1)/2-gg   Else    cos´(­1)*3/2-gg   EndIf  EndIf EndIf Return {d,g} EndFunc
La fonction suivante calcul les Dh et G pour l'implantation à partir des X et Y (matin,xst,yst) Func Local i,matout  newMat(4,dim(matin)[2])matout  listmat(matlist(matin[2])-xst)matout[1]  listmat(matlist(matin[3])-yst)matout[2]  For i,1,dim(matin)[2]   rec2pol(matout[1,i],matout[2,i])[1]matout[3,i]   rec2pol(matout[1,i],matout[2,i])[2]matout[4,i]  EndFor  Return augment(matin;matout) EndFunc
ce petit programme verifie si des données de contrôle sont conforme au tolérance de 2003 (liste,nbd,cp,c) Prgm local t1,t2,t3,emp,np,k,lctrl,i,p,q,lt2,lt3 if nbd=1 then  3.23k elseif nbd=2 then  2.42k else  2.11k endif 0p 0q {}lt2 {}lt3 {0,0,0}lctrl sum(liste/dim(liste))emp cp*(1+1/2*c^2)t1 k*emp/1.1t2 1.5*k*cpt3 0.01*dim(liste)+0.232*¨(dim(liste))np if fpart(np)0 then  ipart(np)+1np EndIf for i,1,dim(liste)  if liste[i]>t2 then   p+1p   augment(lt2,{liste[i]})lt2  EndIf  if liste[i]>t3 then   q+1q   augment(lt3,{liste[i]})lt3  endif endfor if emp<t1 then  1lctrl[1] EndIf if pœnp then  1lctrl[2] endif if dim(lt3)=0 then  1lctrl[3] endif ClrIO Output 0,0,"T1=" output 0,18,approx(t1) Output 8,0,"T2=" output 8,18,approx(t2) Output 16,0,"T3=" output 16,18,approx(t3) Output 24,0,"emp=" output 24,24,approx(emp) Output 32,0,"n'=" output 32,18,exact(np) if lctrl[1]=1 then  output 40,0,"critère n°1:emp<T1 oui" else  output 40,0,"critère n°1:emp<T1 non" EndIf if lctrl[2]=1 then  output 48,0,"critère n°2: nb de e>T2 < à n' oui" else  output 48,0,"critère n°2: nb de e>T2 < à n' non" EndIf if lctrl[3]=1 then  output 56,0,"critère n°3:Aucun e>T3 oui" else  output 56,0,"critère n°3:Aucun e>T3 non" EndIf pause output 64,0,"elmt>T2 : "&string(p) if dim(lt2)0 then  pause lt2 Endif if dim(lt3)0 then   output 85,0,"elmt>T3 : "&string(q)   pause lt3 else  if dim(lt2)0 then   output 85,0,"elmt>T3 : "&string(q)   pause  else   output 72,0,"elmt>T3 : "&string(q)   pause  EndIf endif EndPrgm



Voilà je viens de vous donner tous mon travail actuel. Si vous avez d'autre fonctions où programme utile n'esitez pas a envoyer vos sources (Le BTS est pour bientôt), merci d'avance.
En particulier je recherche une fonction pour le calcul des rabatement et des relevement sur plusieur points si possible avec la méthode des moindre caré une fois que l'on a calculé les coordonnées des points approchés.