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:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
|
Option Explicit
Const unit_inches As Boolean = False 'If false, then centimeter is the unit
Sub Draw_Left_Triangle()
Call Draw_Triangle(True)
End Sub
Sub Draw_Right_Triangle()
Call Draw_Triangle
End Sub
Private Sub Draw_Triangle(Optional left_to_right As Boolean = False)
Dim doc As Document
Dim dim_x As Single
Dim dim_h As Single
Dim shp_circle As Shape
Dim shp_triang As Shape
Dim shp_line As Shape
Dim base_left As Single
Dim base_top As Single
Set doc = ActiveDocument
With Selection.Range
base_left = .Information(wdHorizontalPositionRelativeToPage)
base_top = .Information(wdVerticalPositionRelativeToPage)
End With
If (unit_inches) Then
dim_x = InputBox("Width Please - inches", , 3)
dim_h = InputBox("Height Please - inches", , 4)
dim_x = Application.InchesToPoints(dim_x)
dim_h = Application.InchesToPoints(dim_h)
Else
dim_x = InputBox("Width Please - cm", , 3)
dim_h = InputBox("Height Please - cm", , 4)
dim_x = Application.CentimetersToPoints(dim_x)
dim_h = Application.CentimetersToPoints(dim_h)
End If
Set shp_triang = doc.Shapes.AddShape(msoShapeRightTriangle, base_left, base_top, dim_x, dim_h)
If left_to_right Then
With shp_triang
.Flip msoFlipHorizontal
End With
End If
Call Draw_Scale(base_left, base_top + dim_h + 10)
End Sub
Sub Draw_Triangle_In_Circle_With_Line()
Dim doc As Document
Dim diameter As Single
Dim dim_r As Single
Dim dim_x As Single
Dim dim_h As Single
Dim shp_circle As Shape
Dim shp_triang As Shape
Dim shp_line As Shape
Dim base_left As Single
Dim base_top As Single
Set doc = ActiveDocument
With Selection.Range
base_left = .Information(wdHorizontalPositionRelativeToPage)
base_top = .Information(wdVerticalPositionRelativeToPage)
End With
If (unit_inches) Then
diameter = InputBox("Diameter please - inches", , 3)
dim_r = Application.InchesToPoints(diameter) / 2
Else
diameter = InputBox("Diameter please - cm", , 3)
dim_r = Application.CentimetersToPoints(diameter) / 2
End If
Set shp_circle = doc.Shapes.AddShape(msoShapeOval, base_left, base_top, dim_r * 2, dim_r * 2)
shp_circle.Line.Weight = 0.25
dim_x = dim_r * Sqr(3)
dim_h = dim_x * Sqr(3) / 2
Set shp_triang = doc.Shapes.AddShape(msoShapeIsoscelesTriangle, base_left, base_top, dim_x, dim_h)
With shp_triang
.Left = shp_triang.Left + (dim_r * 2 - dim_x) / 2
.Line.Weight = 0.25
End With
Set shp_line = doc.Shapes.AddLine(base_left, base_top, base_left, base_top + dim_h)
With shp_line
.Left = shp_triang.Left + dim_x / 2
.Top = shp_triang.Top
End With
doc.Shapes.Range(Array(shp_circle.Name, shp_triang.Name, shp_line.Name)).Group
Call Draw_Scale(base_left, base_top + dim_r * 2 + 10)
End Sub
Sub Draw_Circle_In_Triangle()
Dim doc As Document
Dim diameter As Single
Dim dim_r As Single
Dim dim_x As Single
Dim dim_h As Single
Dim shp_circle As Shape
Dim shp_triang As Shape
Dim shp_line As Shape
Dim base_left As Single
Dim base_top As Single
Set doc = ActiveDocument
With Selection.Range
base_left = .Information(wdHorizontalPositionRelativeToPage)
base_top = .Information(wdVerticalPositionRelativeToPage)
End With
If (unit_inches) Then
diameter = InputBox("Diameter please - inches", , 3)
dim_r = Application.InchesToPoints(diameter) / 2
Else
diameter = InputBox("Diameter please - cm", , 3)
dim_r = Application.CentimetersToPoints(diameter) / 2
End If
Set shp_circle = doc.Shapes.AddShape(msoShapeOval, base_left, base_top, dim_r * 2, dim_r * 2)
dim_x = dim_r * 2 * Sqr(3)
dim_h = dim_x * Sqr(3) / 2
With shp_circle
.Line.Weight = 0.25
.Top = .Top + dim_h / 3
End With
Set shp_triang = doc.Shapes.AddShape(msoShapeIsoscelesTriangle, base_left, base_top, dim_x, dim_h)
With shp_triang
.Left = shp_triang.Left + (dim_r * 2 - dim_x) / 2
.Line.Weight = 0.25
.ZOrder msoSendBackward
End With
doc.Shapes.Range(Array(shp_circle.Name, shp_triang.Name)).Group
Call Draw_Scale(base_left + dim_r - dim_x / 2, base_top + dim_r * 3 + 10)
End Sub
Sub Draw_Scale(Optional s_left As Single = 50, Optional s_top As Single = 50)
Dim doc As Document
Dim unit_count As Integer
Dim unit_length As Single
Dim shp_line As Shape
Dim i As Integer
Set doc = ActiveDocument
unit_count = InputBox("Scale Length Please (0 for none)", , 0)
If unit_count = 0 Then Exit Sub
If (unit_inches) Then
unit_length = Application.InchesToPoints(1)
Else
unit_length = Application.CentimetersToPoints(1)
End If
Set shp_line = doc.Shapes.AddLine(s_left, s_top + 15, s_left + unit_length * unit_count, s_top + 15)
For i = 0 To unit_count
With doc.Shapes.AddLine(s_left + i * unit_length, s_top, s_left + i * unit_length, s_top + 30)
doc.Shapes.Range(Array(doc.Shapes.Count - 1, doc.Shapes.Count)).Group
End With
Next i
End Sub
|
