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
|
Sub genererTraitPerpendiculaire()
Dim tailleTrait As Single
Dim tabPoints()
Dim tabPoints1() As String
Dim tabPoints2() As String
Dim normeV2
Dim v1(2) As Single
Dim x1, x2, y1, y2
Dim j As Integer
Dim v2 As Variant
Dim nomForme As String
nomForme = Selection.ShapeRange.Name
tailleTrait = 5
With Worksheets("Plan1")
ReDim tabPoints(2, 2)
'enlève la flêche
.Shapes(nomForme).Line.EndArrowheadStyle = msoArrowheadNone
'donne a Tabpoints1 les coordonnées du 1er noeud
tabPoints1 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count - 1).points
'donne a Tabpoints2 les coordonnées du 2nd noeud
tabPoints2 = .Shapes(nomForme).Nodes(.Shapes(nomForme).Nodes.Count).points
For j = 1 To 2
tabPoints(1, j) = tabPoints1(1, j)
tabPoints(2, j) = tabPoints2(1, j)
Next j
v1(1) = tabPoints(1, 1) - tabPoints(2, 1)
v1(2) = tabPoints(1, 2) - tabPoints(2, 2)
v2 = vectOrthogonal(v1)
normeV2 = v2(0) * v2(0) + v2(1) * v2(1)
normeV2 = Sqr(normeV2)
v2(0) = v2(0) / normeV2
v2(1) = v2(1) / normeV2
v2(0) = tailleTrait * v2(0)
v2(1) = tailleTrait * v2(1)
x1 = tabPoints(2, 1) - v2(0)
x2 = tabPoints(2, 1) + v2(0)
y1 = tabPoints(2, 2) - v2(1)
y2 = tabPoints(2, 2) + v2(1)
.Shapes.AddLine(x1, y1, x2, y2).Select
End With
End Sub |
Partager