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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
'---------------------------------------------------------------------------------------
' Procedure : RejetEpaisseur
' Auteur : Jean-Marc
' Date : 29/03/2010
' Sujet : Cette fonction retourne un vecteur de longueur 1 perpendiculaire à une
' droite définie par 2 points pd et pa et de sens allant vers le 3e point
' cliqué. Protection si le pt cliqué est sur la droite.
'---------------------------------------------------------------------------------------
'
Private Function RejetEpaisseur(pd As Variant, pa As Variant, pm As Variant, message As String) As Variant
Dim pr, v
Dim ppSCU, prSCU, pdSCU, paSCU, vSCU
On Error GoTo RejetEpaisseur_Error
Do
pr = ThisDrawing.Utility.GetPoint(pm, message) 'Rejet d'épaisseur dans SCG
prSCU = ThisDrawing.Utility.TranslateCoordinates(pr, acWorld, acUCS, False)
paSCU = ThisDrawing.Utility.TranslateCoordinates(pa, acWorld, acUCS, False)
pdSCU = ThisDrawing.Utility.TranslateCoordinates(pd, acWorld, acUCS, False)
ppSCU = DroitePerpPassantParUnPoint(pdSCU, paSCU, prSCU)
vSCU = vect3d(ppSCU, prSCU) 'Vecteur direction dans le SCU
If longVecteur3d(vSCU) <> 0 Then Exit Do
MsgBox "Vous avez cliqué sur la ligne !", vbCritical, "Erreur"
Loop
vSCU = vectUnit3d(vSCU) 'Vecteur unitaire dans le SCU
v = ThisDrawing.Utility.TranslateCoordinates(vSCU, acUCS, acWorld, True) 'Convertion dans SCG
RejetEpaisseur = v
On Error GoTo 0
Exit Function
RejetEpaisseur_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure RejetEpaisseur du Module Cornieres"
RejetEpaisseur = Null
End Function
'---------------------------------------------------------------------------------------
' Procedure : DroitePerpPassantParUnPoint
' Auteur : Jean-Marc
' Date : 29/03/2010
' Sujet : Cette fonction donne le point d'intersection M de deux droites
' perpendiculaires AB et AM
'---------------------------------------------------------------------------------------
'
Private Function DroitePerpPassantParUnPoint(ptA As Variant, ptB As Variant, ptC As Variant) As Variant
Dim Xa As Double, Ya As Double
Dim Xb As Double, Yb As Double
Dim Xc As Double, Yc As Double
Dim ptD(0 To 2) As Double
Dim a As Double, b As Double
Dim a1 As Double, b1 As Double
On Error GoTo DroitePerpPassantParUnPoint_Error
Xa = ptA(0): Ya = ptA(1)
Xb = ptB(0): Yb = ptB(1)
Xc = ptC(0): Yc = ptC(1)
If (Xb - Xa) <> 0 Then
a = (Yb - Ya) / (Xb - Xa)
b = Ya - a * Xa
If a <> 0 Then
a1 = -1 / a
b1 = Yc - a1 * Xc
ptD(0) = (b1 - b) / (a - a1)
ptD(1) = a * ptD(0) + b
Else 'Droite horizontale
ptD(0) = Xc
ptD(1) = Ya
End If
Else 'Droite verticale
ptD(0) = Xa
ptD(1) = Yc
End If
ptD(2) = ptC(2)
'ptD(2) = ptA(2)
DroitePerpPassantParUnPoint = ptD
On Error GoTo 0
Exit Function
DroitePerpPassantParUnPoint_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure DroitePerpPassantParUnPoint du Module Cornieres"
End Function
'Défini un vecteur3d à partir de 2 points
Private Function vect3d(pointA As Variant, pointB As Variant) As Variant
Dim Tableau(0 To 2) As Double
Tableau(0) = pointB(0) - pointA(0)
Tableau(1) = pointB(1) - pointA(1)
Tableau(2) = pointB(2) - pointA(2)
vect3d = Tableau
End Function
'Calculer la norme d'un vecteur 3d
Private Function longVecteur3d(vecteur As Variant) As Double
longVecteur3d = Sqr(vecteur(0) ^ 2 + vecteur(1) ^ 2 + vecteur(2) ^ 2)
End Function
'Défini en 3d le vecteur unitaire d'un vecteur
Private Function vectUnit3d(vecteur) As Variant
Dim Tableau(0 To 2) As Double
Dim longueur As Double
longueur = longVecteur3d(vecteur)
Tableau(0) = vecteur(0) / longueur
Tableau(1) = vecteur(1) / longueur
Tableau(2) = vecteur(2) / longueur
vectUnit3d = Tableau
End Function |
