Calcul topo sur excel avec fonction vba

Télécharger le projet
Commenter

Description

Le but de TOPOVB est de faire une grande quantité de calcul topo sur EXCEL.
Calculer des points tous les 10 cm sur un axe routier, axe décalé, ...
Il est donc très pratique en projet routier si l'on dispose de la tabulation de l'axe.
Par simple recopier les cellules vers le bas.
Exemple : =XYG(XS;YS;LC(-2);LC(-1)) ici les cellules XStation et YStation sont nomées.
=XYGDX(L24C2;L24C3;LC(-2);LC(-1)) ici les cellules XStation et YStation sont figées.
=RCX($B$102;$C$102;$D$102;$E$102;$F$102;$G$102;B117) ici les cellules XStation et YStation sont figées.
=XYG(100;500;110;510) ici tout est rempli( résultat = 50 grades).

Liste des fonctions disponibles dans TOPOVB:

= XYG(Xstation, Ystation, Xpoint, Ypoint) Converti des coordonnées rectangulaires en gisement exprimés en Grades.
= XYD(Xstation, Ystation, Xpoint, Ypoint) Converti des coordonnées rectangulaires en distances.
= XYGDX(Xstation, Ystation, GISEMENT, DISTANCE) Converti des coordonnées POLAIRES exprimés en grades en coordonnées X.
= XYGDY(Xstation, Ystation, GISEMENT, DISTANCE) Converti des coordonnées POLAIRES exprimés en grades en coordonnées Y.
= DROITEABSX(AbsDep, Xdep, Ydep, Xfin, Yfin, AbsPoint) Calcul des points intermédiaires sur une droite, donne X.
= DROITEABSY(AbsDep, Xdep, Ydep, Xfin, Yfin, AbsPoint) Calcul des points intermédiaires sur une droite, donne Y.
= IDGX(X_Doite_1, Y_Doite_1, Gisement_Doite_1_Grades, X_Doite_2, Y_Doite_2, Gisement_Doite_2_Grades)
Calcul l'intersection de 2 droites en X en donnant les origines des droites en X/Y et leurs gisements.
= IDGY(X_Doite_1, Y_Doite_1, Gisement_Doite_1_Grades, X_Doite_2, Y_Doite_2, Gisement_Doite_2_Grades)
Calcul l'intersection de 2 droites en Y en donnant les origines des droites en X/Y et leurs gisements.
= ICX(X_Centre_1, Y_Centre_1, R1, X_Centre_2, Y_Centre_2, R2, Solution_D_G)
Calcul l'intersection de 2 CERCLES en X en donnant les CENTRES des CERCLES en X/Y et leurs RAYONS.
= ICY(X_Centre_1, Y_Centre_1, R1, X_Centre_2, Y_Centre_2, R2, Solution_D_G)
Calcul l'intersection de 2 CERCLES en Y en donnant les CENTRES des CERCLES en X/Y et leurs RAYONS.
= RCX(X_Centre, Y_Centre, R_négatif_à_droite, X_Tg_Départ, Y_Tg_Départ, Absisse_Tg_Départ, Absisse_Point)
Calcul un raccordement circulaire en X en donnant le centre,la tangente et sont absisse et l'absisse du point a calculer.
= RCY(X_Centre, Y_Centre, R_négatif_à_droite, X_Tg_Départ, Y_Tg_Départ, Absisse_Tg_Départ, Absisse_Point)
Calcul un raccordement circulaire en Y en donnant le centre,la tangente et sont absisse et l'absisse du point a calculer.
= PIP(Absisse_Tg_A, Z_Tg_A, Pente_en_Tg_A, Absisse_Tg_B, Z_Tg_B, Pente_en_Tg_B, Rayon_négatif_bosse, Absisse_Point)
Calcul le Z d'un point sur une parabole.
= PIPHBX(Absisse_Tg_A, Z_Tg_A, Pente_en_Tg_A, Absisse_Tg_B, Z_Tg_B, Pente_en_Tg_B, Rayon_négatif_bosse)
Calcul l'absisse du point Haut ou point Bas sur une parabole.
= PICX(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Début_DROITE, Y_Début_DROITE, Rayon_négatif_DROITE, Longueur_L, Absisse)
Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'X.
= PICY(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Début_DROITE, Y_Début_DROITE, Rayon_négatif_DROITE, Longueur_L, Absisse)
Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'Y.
= PIC2X(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Rayon_négatif_DROITE, Longueur_L, Absisse)
Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'X.
= PIC2Y(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Rayon_négatif_DROITE, Longueur_L, Absisse)
Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'Y.
= GISAXECLOTH(Gis_droite_Grades, Abs_Tg_DROITE, Abs_Tg_CERCLE, Rayon_négatif_DROITE, Absisse)
Calcul le gisement de l'axe sur une clothoide dos à la droite.
= GISAXECLOTH2(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Abs_Tg_CERCLE, Ray_nég_Droite_DàDr, Absisse)
Calcul le gisement de l'axe sur une clothoide dos à la droite.

Mode opératoire sur EXCEL:
Formules / Insérer une fonction / Catégiries -> Personalisées / Choisir une fonction TOPOVB7 ... / Utiliser la boite de dialogue.

Source / Exemple : 


'Tous droits réservés    Copyright 1997   TOUBIN RICHARD
'L 'utilisateur prend ses responsabilités quant à l'utilisation de ce Programme, à la vérification des résultats.
'L'AUTEUR N'ASSUME AUCUNE GARANTIE DE QUELQUE NATURE ET A QUELQUE TITRE
'QUE CE SOIT EXPLICITE OU IMPLICITE, DE CONFORMITE OU D'ADEQUATION A UN USAGE SPECIFIQUE DU LOGICIEL.
'EN TOUT ETAT DE CAUSE LA RESPONSABILITE DE L'AUTEUR NE POURRA EN AUCUN CAS EXCEDER LE MONTANT EFFECTIVEMENT PAYE POUR L'ACQUISITION DU LOGICIEL.
'Ce logiciel est GRATUIT et peut être redistribué dans sont intégralité et gratuitement
'
'
'
'Remarques / Remercïments / Dons ...       Auteur : richardtoubin@live.fr
'
'
'
'Pour utiliser ce fichier vous pouvez :
'       *Ouvrir ce fichier XLS et utiliser les feuilles tells qu'elles. Dans ce cas si vous distribuez
'ce fichier les fonctions personalisée fonctionneront car elles font parti du fichier.
'       *Séparer le fichier XLA et le charger automatiquement à l'ouverture d'EXCEL.
'Dans ce cas vous pourez utiliser les fonctions personalisées dans n'importe que fichier et feuille EXCEL.
'Par contre si vous enregistrez un fichier qui utilise une de ces fonctions et que vous donnez ce fichier,
'n'oubliez pas de lui fournir aussi le fichier XLA, sans quoi l'appel d'une fonction se soldera par un
'   #NOM? car Excel ne trouvera pas la fonction sur le PC de votre ami.
'Vous pouvez aussi ne fournir que des données avec un copier/colage spécial/coller des valeurs.
'Ou encore enregistrer votre fichier au format CSV.
'
'
'
'
'---------------------------------------------------------------------------------------------
'Début des fonctions personalisées :
'---------------------------------------------------------------------------------------------
' XYG Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Converti des coordonnées rectangulaires en gisement exprimés en Grades.
'

Function XYG(Xstation, Ystation, Xpoint, Ypoint)
Pi = 4 * Atn(1)
    If Ypoint - Ystation = 0 Then
        If Xpoint - Xstation > 0 Then
        XYG = 100
        End If
    End If
    If Xpoint - Xstation = 0 Then
        If Ypoint - Ystation < 0 Then
        XYG = 200
        End If
    End If
    If Ypoint - Ystation = 0 Then
        If Xpoint - Xstation < 0 Then
        XYG = 300
        End If
    End If
    If Ypoint - Ystation > 0 Then
        If Xpoint - Xstation > 0 Then
        XYG = (Atn((Xpoint - Xstation) / (Ypoint - Ystation))) / Pi * 200
        ElseIf Xpoint - Xstation < 0 Then
        'XYG = 300 - (Arctan((Xpoint - Xstation) / (Ypoint - Ystation)) / Pi * 200)
        XYG = 400 + ((Atn((Xpoint - Xstation) / (Ypoint - Ystation)) / Pi * 200))
        ElseIf Xpoint - Xstation = 0 Then
        XYG = 0
        End If
    End If
    If Ypoint - Ystation < 0 Then
        If Xpoint - Xstation > 0 Then
        XYG = 200 + (Atn((Xpoint - Xstation) / (Ypoint - Ystation)) / Pi * 200)
        ElseIf Xpoint - Xstation < 0 Then
        XYG = 200 + (Atn((Xpoint - Xstation) / (Ypoint - Ystation)) / Pi * 200)
        End If
    End If
End Function

'---------------------------------------------------------------------------------------------
' XYD Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Converti des coordonnées rectangulaires en distances.
'

Function XYD(Xstation, Ystation, Xpoint, Ypoint)
XYD = Sqr((Xpoint - Xstation) ^ 2 + (Ypoint - Ystation) ^ 2)
End Function

'---------------------------------------------------------------------------------------------
' XYGDX Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Converti des coordonnées POLAIRES exprimés en grades en coordonnées X.
'
Function XYGDX(Xstation, Ystation, GISEMENT, DISTANCE)
Pi = 4 * Atn(1)
XYGDX = Xstation + (DISTANCE * Sin(GISEMENT / 200 * Pi))
End Function

'---------------------------------------------------------------------------------------------
' XYGDY Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Converti des coordonnées POLAIRES exprimés en grades en coordonnées Y.
'
Function XYGDY(Xstation, Ystation, GISEMENT, DISTANCE)
Pi = 4 * Atn(1)
XYGDY = Ystation + (DISTANCE * Cos(GISEMENT / 200 * Pi))
End Function

'---------------------------------------------------------------------------------------------
' DROITEABSX Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une droite.
' Les absisse sont considérés croissants du départ vers la fin.

Function DROITEABSX(AbsDep, Xdep, Ydep, Xfin, Yfin, AbsPoint)
Pi = 4 * Atn(1)
If XYD(Xdep, Ydep, Xfin, Yfin) = 0 Then
   DROITEABSX = 0
Else: DROITEABSX = XYGDX(Xdep, Ydep, XYG(Xdep, Ydep, Xfin, Yfin), AbsPoint - AbsDep)
End If
End Function

'---------------------------------------------------------------------------------------------
' DROITEABSY Macro VB
' Macro enregistrée le 16/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une droite.
' Les absisses sont considérés croissants du départ vers la fin.

Function DROITEABSY(AbsDep, Xdep, Ydep, Xfin, Yfin, AbsPoint)
Pi = 4 * Atn(1)
If XYD(Xdep, Ydep, Xfin, Yfin) = 0 Then
   DROITEABSY = 0
Else: DROITEABSY = XYGDY(Xdep, Ydep, XYG(Xdep, Ydep, Xfin, Yfin), AbsPoint - AbsDep)
End If
End Function

'---------------------------------------------------------------------------------------------
' IDGX Macro VB
' Macro enregistrée le 19/09/1997 par TOUBIN RICHARD
' Calcul l'intersection de 2 droites en X en donnant les origines des droites en X/Y
' et leurs gisements.
Function IDGX(X_Doite_1, Y_Doite_1, Gisement_Doite_1_Grades, X_Doite_2, Y_Doite_2, Gisement_Doite_2_Grades)
Pi = 4 * Atn(1)
G1 = Gisement_Doite_1_Grades / 200 * Pi
G2 = Gisement_Doite_2_Grades / 200 * Pi
G3 = XYG(X_Doite_2, Y_Doite_2, X_Doite_1, Y_Doite_1) / 200 * Pi
DAB = XYD(X_Doite_1, Y_Doite_1, X_Doite_2, Y_Doite_2)
LM = (Sin(G2 - G3) * DAB) / Cos(G1 - (G2 + (Pi / 2)))
IDGX = XYGDX(X_Doite_1, Y_Doite_1, G1 / Pi * 200, LM)
End Function

'---------------------------------------------------------------------------------------------
' IDGY Macro VB
' Macro enregistrée le 19/09/1997 par TOUBIN RICHARD
' Calcul l'intersection de 2 droites en Y en donnant les origines des droites en X/Y
' et leurs gisements.
Function IDGY(X_Doite_1, Y_Doite_1, Gisement_Doite_1_Grades, X_Doite_2, Y_Doite_2, Gisement_Doite_2_Grades)
Pi = 4 * Atn(1)
G1 = Gisement_Doite_1_Grades / 200 * Pi
G2 = Gisement_Doite_2_Grades / 200 * Pi
G3 = XYG(X_Doite_2, Y_Doite_2, X_Doite_1, Y_Doite_1) / 200 * Pi
DAB = XYD(X_Doite_1, Y_Doite_1, X_Doite_2, Y_Doite_2)
LM = (Sin(G2 - G3) * DAB) / Cos(G1 - (G2 + (Pi / 2)))
IDGY = XYGDY(X_Doite_1, Y_Doite_1, G1 / Pi * 200, LM)
End Function

'---------------------------------------------------------------------------------------------
' ICX Macro VB
' Macro enregistrée le 22/09/1997 par TOUBIN RICHARD
' Calcul l'intersection de 2 CERCLES en X en donnant les CENTRES des CERCLES en X/Y
' et leurs RAYONS.

Function ICX(X_Centre_1, Y_Centre_1, R1, X_Centre_2, Y_Centre_2, R2, Solution_D_G)
Pi = 4 * Atn(1)
DCC = XYD(X_Centre_1, Y_Centre_1, X_Centre_2, Y_Centre_2)
C1H = ((DCC * DCC) + (R1 * R1) - (R2 * R2)) / (2 * DCC)
HI = Sqr((R1 * R1) - (C1H * C1H))
Alpha = Atn(HI / C1H) / Pi * 200
GCC = XYG(X_Centre_1, Y_Centre_1, X_Centre_2, Y_Centre_2)
    If Solution_D_G = "D" Then
        ICX = XYGDX(X_Centre_1, Y_Centre_1, GCC + Alpha, R1)
        ElseIf Solution_D_G = "G" Then
        ICX = XYGDX(X_Centre_1, Y_Centre_1, GCC - Alpha, R1)
    End If
End Function

'---------------------------------------------------------------------------------------------
' ICY Macro VB
' Macro enregistrée le 22/09/1997 par TOUBIN RICHARD
' Calcul l'intersection de 2 CERCLES en Y en donnant les CENTRES des CERCLES en X/Y
' et leurs RAYONS.

Function ICY(X_Centre_1, Y_Centre_1, R1, X_Centre_2, Y_Centre_2, R2, Solution_D_G)
Pi = 4 * Atn(1)
DCC = XYD(X_Centre_1, Y_Centre_1, X_Centre_2, Y_Centre_2)
C1H = ((DCC * DCC) + (R1 * R1) - (R2 * R2)) / (2 * DCC)
HI = Sqr((R1 * R1) - (C1H * C1H))
Alpha = Atn(HI / C1H) / Pi * 200
GCC = XYG(X_Centre_1, Y_Centre_1, X_Centre_2, Y_Centre_2)
    If Solution_D_G = "D" Then
        ICY = XYGDY(X_Centre_1, Y_Centre_1, GCC + Alpha, R1)
        ElseIf Solution_D_G = "G" Then
        ICY = XYGDY(X_Centre_1, Y_Centre_1, GCC - Alpha, R1)
    End If
End Function

'---------------------------------------------------------------------------------------------
' RCX Macro VB
' Macro enregistrée le 25/09/1997 par TOUBIN RICHARD
' Calcul un raccordement circulaire en X en donnant le centre,la tangente et sont
' absisse et l'absisse du point a calculer.

Function RCX(X_Centre, Y_Centre, R_négatif_à_droite, X_Tg_Départ, Y_Tg_Départ, Absisse_Tg_Départ, Absisse_Point)
Pi = 4 * Atn(1)
G = XYG(X_Centre, Y_Centre, X_Tg_Départ, Y_Tg_Départ)
L = Absisse_Point - Absisse_Tg_Départ
RCX = XYGDX(X_Centre, Y_Centre, G + ((200 * L) / (-Pi * R_négatif_à_droite)), Abs(R_négatif_à_droite))
End Function

'---------------------------------------------------------------------------------------------
' RCY Macro VB
' Macro enregistrée le 25/09/1997 par TOUBIN RICHARD
' Calcul un raccordement circulaire en Y en donnant le centre,la tangente et sont
' absisse et l'absisse du point a calculer.

Function RCY(X_Centre, Y_Centre, R_négatif_à_droite, X_Tg_Départ, Y_Tg_Départ, Absisse_Tg_Départ, Absisse_Point)
Pi = 4 * Atn(1)
G = XYG(X_Centre, Y_Centre, X_Tg_Départ, Y_Tg_Départ)
L = Absisse_Point - Absisse_Tg_Départ
RCY = XYGDY(X_Centre, Y_Centre, G + ((200 * L) / (-Pi * R_négatif_à_droite)), Abs(R_négatif_à_droite))
End Function

'---------------------------------------------------------------------------------------------
' PIP Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul le Z d'un point sur une parabole.

Function PIP(Absisse_Tg_A, Z_Tg_A, Pente_en_Tg_A, Absisse_Tg_B, Z_Tg_B, Pente_en_Tg_B, Rayon_négatif_bosse, Absisse_Point)
PA = Pente_en_Tg_A / 100
PB = Pente_en_Tg_B / 100
W = Absisse_Tg_B - Absisse_Tg_A
Q = W * PA
U = Z_Tg_A + Q
P = U - Z_Tg_B
t = W * (-PB)
H = Z_Tg_B + t
I = (H) - (Z_Tg_A)
HB = (W * P) / (I + P)
HA = W - HB
XS = Absisse_Tg_A + HA
ZS = Z_Tg_B - (HB * PB)
E = Rayon_négatif_bosse * PA
u_F = Rayon_négatif_bosse * PB
L = u_F - E
TE = L / 2
G = XS - TE
Y = XS + TE
m = ZS + (TE * (-PA))
V = ZS + (TE * PB)
XO = G - E
N = (Rayon_négatif_bosse / 2) * (PA * PA)
O = m - N
X = Absisse_Point - XO
Y2 = (X * X) / (2 * Rayon_négatif_bosse)
Z = O + Y2
PIP = Z
End Function

'---------------------------------------------------------------------------------------------
' PIPHBX Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul l'absisse du point Haut ou point Bas sur une parabole.

Function PIPHBX(Absisse_Tg_A, Z_Tg_A, Pente_en_Tg_A, Absisse_Tg_B, Z_Tg_B, Pente_en_Tg_B, Rayon_négatif_bosse)
PA = Pente_en_Tg_A / 100
PB = Pente_en_Tg_B / 100
W = Absisse_Tg_B - Absisse_Tg_A
Q = W * PA
U = Z_Tg_A + Q
P = U - Z_Tg_B
t = W * (-PB)
H = Z_Tg_B + t
I = (H) - (Z_Tg_A)
HB = (W * P) / (I + P)
HA = W - HB
XS = Absisse_Tg_A + HA
E = Rayon_négatif_bosse * PA
u_F = Rayon_négatif_bosse * PB
L = u_F - E
TE = L / 2
G = XS - TE
XO = G - E
PIPHBX = XO
End Function

'---------------------------------------------------------------------------------------------
' PICX Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'X.

Function PICX(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Début_DROITE, Y_Début_DROITE, Rayon_négatif_DROITE, Longueur_L, Absisse)
Pi = 4 * Atn(1)
L = Longueur_L
R = Rayon_négatif_DROITE
AP = Sqr(Abs(R * L))
XA = (L - ((L ^ 5) / (40 * (AP ^ 4)))) + ((L ^ 9) / (3456 * (AP ^ 8)))
YA = ((L ^ 3) / (6 * (AP ^ 2))) - ((L ^ 7) / (336 * (AP ^ 6))) + ((L ^ 11) / (42240 * (AP ^ 10)))
'Calcul du gisement GD en RADIAN de la droite
GD = XYG(X_Début_DROITE, Y_Début_DROITE, X_Tg_Droite, Y_Tg_Droite) / 200 * Pi
'Calcul d'un point intermédiaire.
LP = Abs(Absisse - Abs_Tg_DROITE)
XB = (LP - ((LP ^ 5) / (40 * (AP ^ 4)))) + ((LP ^ 9) / (3456 * (AP ^ 8)))
YB = ((LP ^ 3) / (6 * (AP ^ 2))) - ((LP ^ 7) / (336 * (AP ^ 6))) + ((LP ^ 11) / (42240 * (AP ^ 10)))
XO = X_Tg_Droite
If R < 0 Then
    X = XO + (XB * (Sin(GD))) + (YB * (Cos(GD)))
    Else: X = XO + (XB * (Sin(GD))) - (YB * (Cos(GD)))
End If
PICX = X
End Function

'---------------------------------------------------------------------------------------------
' PICY Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'Y.

Function PICY(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Début_DROITE, Y_Début_DROITE, Rayon_négatif_DROITE, Longueur_L, Absisse)
Pi = 4 * Atn(1)
L = Longueur_L
R = Rayon_négatif_DROITE
AP = Sqr(Abs(R * L))
XA = (L - ((L ^ 5) / (40 * (AP ^ 4)))) + ((L ^ 9) / (3456 * (AP ^ 8)))
YA = ((L ^ 3) / (6 * (AP ^ 2))) - ((L ^ 7) / (336 * (AP ^ 6))) + ((L ^ 11) / (42240 * (AP ^ 10)))
'Calcul du gisement GD en RADIAN de la droite
GD = XYG(X_Début_DROITE, Y_Début_DROITE, X_Tg_Droite, Y_Tg_Droite) / 200 * Pi
'Calcul d'un point intermédiaire.
LP = Abs(Absisse - Abs_Tg_DROITE)
XB = (LP - ((LP ^ 5) / (40 * (AP ^ 4)))) + ((LP ^ 9) / (3456 * (AP ^ 8)))
YB = ((LP ^ 3) / (6 * (AP ^ 2))) - ((LP ^ 7) / (336 * (AP ^ 6))) + ((LP ^ 11) / (42240 * (AP ^ 10)))
YO = Y_Tg_Droite
If R < 0 Then
    Y = YO + (XB * (Cos(GD))) - (YB * (Sin(GD)))
    Else: Y = YO + (XB * (Cos(GD))) + (YB * (Sin(GD)))
End If
PICY = Y
End Function

'---------------------------------------------------------------------------------------------
' PIC2X Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'X.

Function PIC2X(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Rayon_négatif_DROITE, Longueur_L, Absisse)
Pi = 4 * Atn(1)
L = Longueur_L
R = Rayon_négatif_DROITE
AP = Sqr(Abs(R * L))
XA = (L - ((L ^ 5) / (40 * (AP ^ 4)))) + ((L ^ 9) / (3456 * (AP ^ 8)))
YA = ((L ^ 3) / (6 * (AP ^ 2))) - ((L ^ 7) / (336 * (AP ^ 6))) + ((L ^ 11) / (42240 * (AP ^ 10)))
'Calcul du gisement G2 en radian de la Tg à la droite vers la Tg au cercle
G2 = XYG(X_Tg_Droite, Y_Tg_Droite, X_Tg_Cercle, Y_Tg_Cercle) / 200 * Pi
'Calcul du gisement GD en radian de la droite
Alpha = (Pi / 2) - (Atn(XA / YA))
If R < 0 Then
    GD = G2 - Alpha
    Else: GD = G2 + Alpha
End If
'Calcul d'un point intermédiaire.
LP = Abs(Absisse - Abs_Tg_DROITE)
XB = (LP - ((LP ^ 5) / (40 * (AP ^ 4)))) + ((LP ^ 9) / (3456 * (AP ^ 8)))
YB = ((LP ^ 3) / (6 * (AP ^ 2))) - ((LP ^ 7) / (336 * (AP ^ 6))) + ((LP ^ 11) / (42240 * (AP ^ 10)))
XO = X_Tg_Droite
If R < 0 Then
    X = XO + (XB * (Sin(GD))) + (YB * (Cos(GD)))
    Else: X = XO + (XB * (Sin(GD))) - (YB * (Cos(GD)))
End If
PIC2X = X
End Function

'---------------------------------------------------------------------------------------------
' PIC2Y Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul des points intermédiaires sur une CLOTHOIDE et renvoi l'Y.

Function PIC2Y(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Rayon_négatif_DROITE, Longueur_L, Absisse)
Pi = 4 * Atn(1)
L = Longueur_L
R = Rayon_négatif_DROITE
AP = Sqr(Abs(R * L))
XA = (L - ((L ^ 5) / (40 * (AP ^ 4)))) + ((L ^ 9) / (3456 * (AP ^ 8)))
YA = ((L ^ 3) / (6 * (AP ^ 2))) - ((L ^ 7) / (336 * (AP ^ 6))) + ((L ^ 11) / (42240 * (AP ^ 10)))
'Calcul du gisement G2 en radian de la Tg à la droite vers la Tg au cercle
G2 = XYG(X_Tg_Droite, Y_Tg_Droite, X_Tg_Cercle, Y_Tg_Cercle) / 200 * Pi
'Calcul du gisement GD en radian de la droite
Alpha = (Pi / 2) - (Atn(XA / YA))
If R < 0 Then
    GD = G2 - Alpha
    Else: GD = G2 + Alpha
End If
'Calcul d'un point intermédiaire.
LP = Abs(Absisse - Abs_Tg_DROITE)
XB = (LP - ((LP ^ 5) / (40 * (AP ^ 4)))) + ((LP ^ 9) / (3456 * (AP ^ 8)))
YB = ((LP ^ 3) / (6 * (AP ^ 2))) - ((LP ^ 7) / (336 * (AP ^ 6))) + ((LP ^ 11) / (42240 * (AP ^ 10)))
YO = Y_Tg_Droite
If R < 0 Then
    Y = YO + (XB * (Cos(GD))) - (YB * (Sin(GD)))
    Else: Y = YO + (XB * (Cos(GD))) + (YB * (Sin(GD)))
End If
PIC2Y = Y
End Function

'---------------------------------------------------------------------------------------------
' GISAXECLOTH Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul le gisement de l'axe sur une clothoide dos à la droite.
Function GISAXECLOTH(Gis_droite_Grades, Abs_Tg_DROITE, Abs_Tg_CERCLE, Rayon_négatif_DROITE, Absisse)
Pi = 4 * Atn(1)
L = Abs(Abs_Tg_CERCLE - Abs_Tg_DROITE)
RC = Rayon_négatif_DROITE
AC = Sqr(Abs(RC * L))
LP = Abs(Absisse - Abs_Tg_DROITE)
If LP = 0 Then
    TETA = 0
    Else: RP = (AC ^ 2) / LP
          TETA = LP / (2 * RP) 'en radians
End If

If RC < 0 Then
     GISCLOT = (Gis_droite_Grades / 200 * Pi) + TETA 'en radians
    Else: GISCLOT = (Gis_droite_Grades / 200 * Pi) - TETA 'en radians
End If

GISAXECLOTH = 400 - (GISCLOT / Pi * 200)
If GISAXECLOTH >= 400 Then
GISAXECLOTH = GISAXECLOTH - 400
End If
If GISAXECLOTH < 0 Then
GISAXECLOTH = GISAXECLOTH + 400
End If
End Function

'---------------------------------------------------------------------------------------------
' GISAXECLOTH2 Macro VB
' Macro enregistrée le 29/09/1997 par TOUBIN RICHARD
' Calcul le gisement de l'axe sur une clothoide dos à la droite.
Function GISAXECLOTH2(X_Tg_Droite, Y_Tg_Droite, Abs_Tg_DROITE, X_Tg_Cercle, Y_Tg_Cercle, Abs_Tg_CERCLE, Ray_nég_Droite_DàDr, Absisse)
Pi = 4 * Atn(1)
L = Abs_Tg_CERCLE - Abs_Tg_DROITE
R = Ray_nég_Droite_DàDr
AP = Sqr(Abs(R * L))
XA = (L - ((L ^ 5) / (40 * (AP ^ 4)))) + ((L ^ 9) / (3456 * (AP ^ 8)))
YA = ((L ^ 3) / (6 * (AP ^ 2))) - ((L ^ 7) / (336 * (AP ^ 6))) + ((L ^ 11) / (42240 * (AP ^ 10)))
'Calcul du gisement G2 en radian de la Tg à la droite vers la Tg au cercle
G2 = XYG(X_Tg_Droite, Y_Tg_Droite, X_Tg_Cercle, Y_Tg_Cercle) / 200 * Pi
'Calcul du gisement GD en radian de la droite
Alpha = (Pi / 2) - (Atn(XA / YA))
'----------------------------------------------
If R < 0 Then
    GD = G2 - Alpha
    Else: GD = G2 + Alpha
End If
RC = Ray_nég_Droite_DàDr
AC = Sqr(Abs(R * L))
LP = Abs(Absisse - Abs_Tg_DROITE)
If LP = 0 Then
    TETA = 0
    Else: RP = (AC ^ 2) / LP
          TETA = (LP / (2 * RP)) 'en radians
End If
If RC < 0 Then
    GISAXECLOTH2 = (GD + TETA) / Pi * 200
    Else: GISAXECLOTH2 = (GD - TETA) / Pi * 200
End If
If L < 0 Then
    GISAXECLOTH2 = GISAXECLOTH2 + 200
End If
If GISAXECLOTH2 >= 400 Then
    GISAXECLOTH2 = GISAXECLOTH2 - 400
End If
If GISAXECLOTH2 < 0 Then
    GISAXECLOTH2 = GISAXECLOTH2 + 400
End If

GISAXECLOTH2 = 400 - GISAXECLOTH2
End Function

Conclusion :


Util en calul topo, notement en projet
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_richardt)