VBA中的将一段程序编程块的问题

dage23wo

纯新手，在网上找了很多关于VBA变成块的问题，但是还是不知道怎么操作，还有，就是镜像后的图形能保存快么，下面是我画的图形，不知道怎么写块，求大神指点下，然后我自己琢磨，谢谢各位对新手的指教。

---

1. Private Sub CommandButton1_Click()
   
2. 
   
3. 
   
4. 
   
5. '#############################################################################图幅起始点
   
6. 
   
7. Dim x, y, z As Double
   
8. 
   
9. '线性添加
   
10. Dim entry As AcadLineType
    
11. Dim found As Boolean
    
12. Dim Itname(0 To 3) As String
    
13. Dim i As Integer
    
14. found = False
    
15. '添加三种线型
    
16. Itname(0) = "BORDER"
    
17. Itname(1) = "CENTER"
    
18. Itname(2) = "DASHDOT"
    
19. Itname(3) = "DASHED"
    
20. For i = 0 To 3
    
21. '搜寻要添加的线型在集合中是否存在
    
22. For Each entry In ThisDrawing.Linetypes
    
23. If StrComp(entry.Name, Itname(i), 1) = 0 Then
    
24. found = True
    
25. Exit For
    
26. End If
    
27. Next
    
28. '如果不存在将其从文件acadiso.lin中加载
    
29. If Not (found) Then
    
30. ThisDrawing.Linetypes.Load Itname(i), "acadiso.lin"
    
31. End If
    
32. Next
    
33. Dim objline(1 To 2000)  As AcadLine
    
34. Dim objarc(1 To 2000)  As AcadArc
    
35. Dim objcircle(1 To 2000) As AcadCircle
    
36. 
    
37. 
    
38. '#############################################################################主视图
    
39. 
    
40. 
    
41. 
    
42. 
    
43. Dim zc As Double
    
44. 
    
45. x = 1000
    
46. y = 1000
    
47. z = 0
    
48. zc = 0
    
49. 
    
50. Dim pt01(2) As Double
    
51. Dim pt02(2) As Double
    
52. Dim pt03(2) As Double
    
53. Dim pt04(2) As Double
    
54. Dim pt05(2) As Double
    
55. Dim pt06(2) As Double
    
56. Dim pt07(2) As Double
    
57. Dim pt08(2) As Double
    
58. Dim pt09(2) As Double
    
59. Dim pt10(2) As Double
    
60. 
    
61. Dim pt11(2) As Double
    
62. Dim pt12(2) As Double
    
63. Dim pt13(2) As Double
    
64. Dim pt14(2) As Double
    
65. Dim pt15(2) As Double
    
66. Dim pt16(2) As Double
    
67. Dim pt17(2) As Double
    
68. Dim pt18(2) As Double
    
69. Dim pt19(2) As Double
    
70. Dim pt20(2) As Double
    
71. 
    
72. Dim pt95(2) As Double
    
73. Dim pt96(2) As Double
    
74. 
    
75. 
    
76. pt01(0) = x: pt01(1) = y: pt01(2) = z
    
77. pt02(0) = x: pt02(1) = y + 40: pt02(2) = z
    
78. pt03(0) = x: pt03(1) = y + 47: pt03(2) = z
    
79. pt04(0) = x: pt04(1) = y + 50: pt04(2) = z
    
80. pt05(0) = x: pt05(1) = y + 57: pt05(2) = z
    
81. pt06(0) = x + 3.3: pt06(1) = y + 57: pt06(2) = z
    
82. pt07(0) = x + 3.3: pt07(1) = y + 50: pt07(2) = z
    
83. pt08(0) = x + 8.9: pt08(1) = y + 50: pt08(2) = z
    
84. pt09(0) = x + 8.9: pt09(1) = y + 47: pt09(2) = z
    
85. pt10(0) = x + 40: pt10(1) = y + 47: pt10(2) = z
    
86. pt11(0) = x + 40: pt11(1) = y + 40: pt11(2) = z
    
87. pt12(0) = x + 90: pt12(1) = y + 40: pt12(2) = z
    
88. pt13(0) = x + 90: pt13(1) = y: pt13(2) = z
    
89. pt14(0) = x + 4.5: pt14(1) = y + 50: pt14(2) = z
    
90. pt15(0) = x + 4.5: pt15(1) = y + 47: pt15(2) = z
    
91. pt16(0) = x + 35: pt16(1) = y + 47: pt16(2) = z
    
92. pt17(0) = x + 35: pt17(1) = y + 40: pt17(2) = z
    
93. 
    
94. pt95(0) = x: pt95(1) = y + 75: pt95(2) = z
    
95. pt96(0) = x: pt96(1) = y - zc - 613: pt96(2) = z
    
96. 
    
97. 
    
98. Dim objLayer As AcadLayer
    
99. Set objLayer = ThisDrawing.Layers.Add("粗实线")
    
100. objLayer.color = acWhite
     
101. objLayer.Linetype = "Continuous"
     
102. objLayer.Lineweight = acLnWt030
     
103. ThisDrawing.ActiveLayer = objLayer
     
104. 
     
105. 
     
106. 
     
107. Set objline(1) = ThisDrawing.ModelSpace.AddLine(pt05, pt06)
     
108. Set objline(2) = ThisDrawing.ModelSpace.AddLine(pt06, pt07)
     
109. Set objline(3) = ThisDrawing.ModelSpace.AddLine(pt04, pt08)
     
110. Set objline(4) = ThisDrawing.ModelSpace.AddLine(pt08, pt09)
     
111. Set objline(5) = ThisDrawing.ModelSpace.AddLine(pt03, pt10)
     
112. Set objline(6) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)
     
113. Set objline(7) = ThisDrawing.ModelSpace.AddLine(pt02, pt12)
     
114. Set objline(8) = ThisDrawing.ModelSpace.AddLine(pt12, pt13)
     
115. Set objline(9) = ThisDrawing.ModelSpace.AddLine(pt01, pt13)
     
116. Set objline(10) = ThisDrawing.ModelSpace.AddLine(pt14, pt15)
     
117. Set objline(11) = ThisDrawing.ModelSpace.AddLine(pt16, pt17)
     
118. 
     
119. 
     
120. Dim xhcs As Integer
     
121. For xhcs = 1 To 11
     
122. objline(xhcs).Mirror pt95, pt96
     
123. Next
     
124. 
     
125. 
     
126. 
     
127. 
     
128. 
     
129. 
     
130. 
     
131. End Sub
     

Private Sub CommandButton1_Click()<br /> <br /> <br /> <br /> '#############################################################################图幅起始点<br /> <br /> Dim x, y, z As Double<br /> <br /> '线性添加<br /> Dim entry As AcadLineType<br /> Dim found As Boolean<br /> Dim Itname(0 To 3) As String<br /> Dim i As Integer<br /> found = False<br /> '添加三种线型<br /> Itname(0) = "BORDER"<br /> Itname(1) = "CENTER"<br /> Itname(2) = "DASHDOT"<br /> Itname(3) = "DASHED"<br /> For i = 0 To 3<br /> '搜寻要添加的线型在集合中是否存在<br /> For Each entry In ThisDrawing.Linetypes<br /> If StrComp(entry.Name, Itname(i), 1) = 0 Then<br /> found = True<br /> Exit For<br /> End If<br /> Next<br /> '如果不存在将其从文件acadiso.lin中加载<br /> If Not (found) Then<br /> ThisDrawing.Linetypes.Load Itname(i), "acadiso.lin"<br /> End If<br /> Next<br /> Dim objline(1 To 2000)  As AcadLine<br /> Dim objarc(1 To 2000)  As AcadArc<br /> Dim objcircle(1 To 2000) As AcadCircle<br /> <br /> <br /> '#############################################################################主视图<br /> <br /> <br /> <br /> <br /> Dim zc As Double<br /> <br /> x = 1000<br /> y = 1000<br /> z = 0<br /> zc = 0<br /> <br /> Dim pt01(2) As Double<br /> Dim pt02(2) As Double<br /> Dim pt03(2) As Double<br /> Dim pt04(2) As Double<br /> Dim pt05(2) As Double<br /> Dim pt06(2) As Double<br /> Dim pt07(2) As Double<br /> Dim pt08(2) As Double<br /> Dim pt09(2) As Double<br /> Dim pt10(2) As Double<br /> <br /> Dim pt11(2) As Double<br /> Dim pt12(2) As Double<br /> Dim pt13(2) As Double<br /> Dim pt14(2) As Double<br /> Dim pt15(2) As Double<br /> Dim pt16(2) As Double<br /> Dim pt17(2) As Double<br /> Dim pt18(2) As Double<br /> Dim pt19(2) As Double<br /> Dim pt20(2) As Double<br /> <br /> Dim pt95(2) As Double<br /> Dim pt96(2) As Double<br /> <br /> <br /> pt01(0) = x: pt01(1) = y: pt01(2) = z<br /> pt02(0) = x: pt02(1) = y + 40: pt02(2) = z<br /> pt03(0) = x: pt03(1) = y + 47: pt03(2) = z<br /> pt04(0) = x: pt04(1) = y + 50: pt04(2) = z<br /> pt05(0) = x: pt05(1) = y + 57: pt05(2) = z<br /> pt06(0) = x + 3.3: pt06(1) = y + 57: pt06(2) = z<br /> pt07(0) = x + 3.3: pt07(1) = y + 50: pt07(2) = z<br /> pt08(0) = x + 8.9: pt08(1) = y + 50: pt08(2) = z<br /> pt09(0) = x + 8.9: pt09(1) = y + 47: pt09(2) = z<br /> pt10(0) = x + 40: pt10(1) = y + 47: pt10(2) = z<br /> pt11(0) = x + 40: pt11(1) = y + 40: pt11(2) = z<br /> pt12(0) = x + 90: pt12(1) = y + 40: pt12(2) = z<br /> pt13(0) = x + 90: pt13(1) = y: pt13(2) = z<br /> pt14(0) = x + 4.5: pt14(1) = y + 50: pt14(2) = z<br /> pt15(0) = x + 4.5: pt15(1) = y + 47: pt15(2) = z<br /> pt16(0) = x + 35: pt16(1) = y + 47: pt16(2) = z<br /> pt17(0) = x + 35: pt17(1) = y + 40: pt17(2) = z<br /> <br /> pt95(0) = x: pt95(1) = y + 75: pt95(2) = z<br /> pt96(0) = x: pt96(1) = y - zc - 613: pt96(2) = z<br /> <br /> <br /> Dim objLayer As AcadLayer<br /> Set objLayer = ThisDrawing.Layers.Add("粗实线")<br /> objLayer.color = acWhite<br /> objLayer.Linetype = "Continuous"<br /> objLayer.Lineweight = acLnWt030<br /> ThisDrawing.ActiveLayer = objLayer<br /> <br /> <br /> <br /> Set objline(1) = ThisDrawing.ModelSpace.AddLine(pt05, pt06)<br /> Set objline(2) = ThisDrawing.ModelSpace.AddLine(pt06, pt07)<br /> Set objline(3) = ThisDrawing.ModelSpace.AddLine(pt04, pt08)<br /> Set objline(4) = ThisDrawing.ModelSpace.AddLine(pt08, pt09)<br /> Set objline(5) = ThisDrawing.ModelSpace.AddLine(pt03, pt10)<br /> Set objline(6) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)<br /> Set objline(7) = ThisDrawing.ModelSpace.AddLine(pt02, pt12)<br /> Set objline(8) = ThisDrawing.ModelSpace.AddLine(pt12, pt13)<br /> Set objline(9) = ThisDrawing.ModelSpace.AddLine(pt01, pt13)<br /> Set objline(10) = ThisDrawing.ModelSpace.AddLine(pt14, pt15)<br /> Set objline(11) = ThisDrawing.ModelSpace.AddLine(pt16, pt17)<br /> <br /> <br /> Dim xhcs As Integer<br /> For xhcs = 1 To 11<br /> objline(xhcs).Mirror pt95, pt96<br /> Next<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> End Sub<br />

看天的小树

2. 
   
3. Private Sub CommandButton1_Click()   '点击按钮_程序
   
4. 
   
5. 
   
6. 
   
7. 
   
8. 
   
9. '#############################################################################图幅起始点
   
10. 
    
11. 
    
12. Dim x, y, z As Double
    
13. 
    
14. 
    
15. '线性添加
    
16. 
    
17. Dim entry As AcadLineType  '声明线型
    
18. 
    
19. Dim found As Boolean
    
20. 
    
21. Dim Itname(0 To 3) As String  '声明数组
    
22. 
    
23. Dim i As Integer
    
24. 
    
25. found = False
    
26. 
    
27. '添加三种线型
    
28. 
    
29. Itname(0) = "BORDER"
    
30. 
    
31. Itname(1) = "CENTER"
    
32. 
    
33. Itname(2) = "DASHDOT"
    
34. 
    
35. Itname(3) = "DASHED"
    
36. 
    
37. For i = 0 To 3
    
38. 
    
39. '搜寻要添加的线型在集合中是否存在
    
40. 
    
41. For Each entry In ThisDrawing.Linetypes   '在线型中循环
    
42. 
    
43. If StrComp(entry.Name, Itname(i), 1) = 0 Then'如果线型名字为三种的一种
    
44. 
    
45. found = True
    
46. 
    
47. Exit For  '退出循环
    
48. 
    
49. End If
    
50. 
    
51. Next
    
52. 
    
53. '如果不存在将其从文件acadiso.lin中加载
    
54. 
    
55. If Not (found) Then
    
56. 
    
57. ThisDrawing.Linetypes.Load Itname(i), "acadiso.lin" '如果不存在自动加载
    
58. 
    
59. End If
    
60. 
    
61. Next
    
62. 
    
63. Dim objline(1 To 2000)  As AcadLine
    
64. 
    
65. Dim objarc(1 To 2000)  As AcadArc
    
66. 
    
67. Dim objcircle(1 To 2000) As AcadCircle
    
68. 
    
69. 
    
70. 
    
71. 
    
72. '#############################################################################主视图
    
73. 
    
74. 
    
75. 
    
76. 
    
77. 
    
78. 
    
79. 
    
80. Dim zc As Double
    
81. 
    
82. 
    
83. x = 1000
    
84. 
    
85. y = 1000
    
86. 
    
87. z = 0
    
88. 
    
89. zc = 0
    
90. 
    
91. 
    
92. Dim pt01(2) As Double
    
93. 
    
94. Dim pt02(2) As Double
    
95. 
    
96. Dim pt03(2) As Double
    
97. 
    
98. Dim pt04(2) As Double
    
99. [b][b][b][/b][/b][/b]
    
100. Dim pt05(2) As Double
     
101. 
     
102. Dim pt06(2) As Double
     
103. 
     
104. Dim pt07(2) As Double
     
105. 
     
106. Dim pt08(2) As Double
     
107. 
     
108. Dim pt09(2) As Double
     
109. 
     
110. Dim pt10(2) As Double
     
111. 
     
112. 
     
113. Dim pt11(2) As Double
     
114. 
     
115. Dim pt12(2) As Double
     
116. 
     
117. Dim pt13(2) As Double
     
118. 
     
119. Dim pt14(2) As Double
     
120. 
     
121. Dim pt15(2) As Double
     
122. 
     
123. Dim pt16(2) As Double
     
124. 
     
125. Dim pt17(2) As Double
     
126. 
     
127. Dim pt18(2) As Double
     
128. 
     
129. Dim pt19(2) As Double
     
130. 
     
131. Dim pt20(2) As Double
     
132. 
     
133. 
     
134. Dim pt95(2) As Double
     
135. 
     
136. Dim pt96(2) As Double
     
137. 
     
138. 
     
139. 
     
140. 
     
141. pt01(0) = x: pt01(1) = y: pt01(2) = z
     
142. 
     
143. pt02(0) = x: pt02(1) = y + 40: pt02(2) = z
     
144. 
     
145. pt03(0) = x: pt03(1) = y + 47: pt03(2) = z
     
146. 
     
147. pt04(0) = x: pt04(1) = y + 50: pt04(2) = z
     
148. 
     
149. pt05(0) = x: pt05(1) = y + 57: pt05(2) = z
     
150. 
     
151. pt06(0) = x + 3.3: pt06(1) = y + 57: pt06(2) = z
     
152. 
     
153. pt07(0) = x + 3.3: pt07(1) = y + 50: pt07(2) = z
     
154. 
     
155. pt08(0) = x + 8.9: pt08(1) = y + 50: pt08(2) = z
     
156. 
     
157. pt09(0) = x + 8.9: pt09(1) = y + 47: pt09(2) = z
     
158. 
     
159. pt10(0) = x + 40: pt10(1) = y + 47: pt10(2) = z
     
160. 
     
161. pt11(0) = x + 40: pt11(1) = y + 40: pt11(2) = z
     
162. 
     
163. pt12(0) = x + 90: pt12(1) = y + 40: pt12(2) = z
     
164. 
     
165. pt13(0) = x + 90: pt13(1) = y: pt13(2) = z
     
166. 
     
167. pt14(0) = x + 4.5: pt14(1) = y + 50: pt14(2) = z
     
168. 
     
169. pt15(0) = x + 4.5: pt15(1) = y + 47: pt15(2) = z
     
170. 
     
171. pt16(0) = x + 35: pt16(1) = y + 47: pt16(2) = z
     
172. 
     
173. pt17(0) = x + 35: pt17(1) = y + 40: pt17(2) = z
     
174. 
     
175. 
     
176. pt95(0) = x: pt95(1) = y + 75: pt95(2) = z
     
177. 
     
178. pt96(0) = x: pt96(1) = y - zc - 613: pt96(2) = z
     
179. 
     
180. 
     
181. 
     
182. 
     
183. Dim objLayer As AcadLayer
     
184. 
     
185. Set objLayer = ThisDrawing.Layers.Add("粗实线")
     
186. 
     
187. objLayer.color = acWhite
     
188. 
     
189. objLayer.Linetype = "Continuous"
     
190. 
     
191. objLayer.Lineweight = acLnWt030
     
192. 
     
193. ThisDrawing.ActiveLayer = objLayer
     
194. 
     
195. 
     
196. 
     
197. 
     
198. 
     
199. Set objline(1) = ThisDrawing.ModelSpace.AddLine(pt05, pt06)
     
200. 
     
201. Set objline(2) = ThisDrawing.ModelSpace.AddLine(pt06, pt07)
     
202. 
     
203. Set objline(3) = ThisDrawing.ModelSpace.AddLine(pt04, pt08)
     
204. 
     
205. Set objline(4) = ThisDrawing.ModelSpace.AddLine(pt08, pt09)
     
206. 
     
207. Set objline(5) = ThisDrawing.ModelSpace.AddLine(pt03, pt10)
     
208. 
     
209. Set objline(6) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)
     
210. 
     
211. Set objline(7) = ThisDrawing.ModelSpace.AddLine(pt02, pt12)
     
212. 
     
213. Set objline(8) = ThisDrawing.ModelSpace.AddLine(pt12, pt13)
     
214. 
     
215. Set objline(9) = ThisDrawing.ModelSpace.AddLine(pt01, pt13)
     
216. 
     
217. Set objline(10) = ThisDrawing.ModelSpace.AddLine(pt14, pt15)
     
218. 
     
219. Set objline(11) = ThisDrawing.ModelSpace.AddLine(pt16, pt17)
     
220. 
     
221. 
     
222. 
     
223. 
     
224. Dim xhcs As Integer
     
225. 
     
226. For xhcs = 1 To 11
     
227. 
     
228. objline(xhcs).Mirror pt95, pt96
     
229. 
     
230. Next
     
231. 
     
232. 
     
233. 
     
234. 
     
235. 
     
236. 
     
237. 
     
238. 
     
239. 
     
240. 
     
241. 
     
242. End Sub

<br /> Private Sub CommandButton1_Click()   '点击按钮_程序<br /> <br /> <br /> <br /> <br /> <br /> '#############################################################################图幅起始点<br /> <br /> <br /> Dim x, y, z As Double<br /> <br /> <br /> '线性添加<br /> <br /> Dim entry As AcadLineType  '声明线型<br /> <br /> Dim found As Boolean<br /> <br /> Dim Itname(0 To 3) As String  '声明数组<br /> <br /> Dim i As Integer<br /> <br /> found = False<br /> <br /> '添加三种线型<br /> <br /> Itname(0) = "BORDER"<br /> <br /> Itname(1) = "CENTER"<br /> <br /> Itname(2) = "DASHDOT"<br /> <br /> Itname(3) = "DASHED"<br /> <br /> For i = 0 To 3<br /> <br /> '搜寻要添加的线型在集合中是否存在<br /> <br /> For Each entry In ThisDrawing.Linetypes   '在线型中循环<br /> <br /> If StrComp(entry.Name, Itname(i), 1) = 0 Then'如果线型名字为三种的一种<br /> <br /> found = True<br /> <br /> Exit For  '退出循环<br /> <br /> End If<br /> <br /> Next<br /> <br /> '如果不存在将其从文件acadiso.lin中加载<br /> <br /> If Not (found) Then<br /> <br /> ThisDrawing.Linetypes.Load Itname(i), "acadiso.lin" '如果不存在自动加载<br /> <br /> End If<br /> <br /> Next<br /> <br /> Dim objline(1 To 2000)  As AcadLine<br /> <br /> Dim objarc(1 To 2000)  As AcadArc<br /> <br /> Dim objcircle(1 To 2000) As AcadCircle<br /> <br /> <br /> <br /> <br /> '#############################################################################主视图<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> Dim zc As Double<br /> <br /> <br /> x = 1000<br /> <br /> y = 1000<br /> <br /> z = 0<br /> <br /> zc = 0<br /> <br /> <br /> Dim pt01(2) As Double<br /> <br /> Dim pt02(2) As Double<br /> <br /> Dim pt03(2) As Double<br /> <br /> Dim pt04(2) As Double<br /> [b][b][b][/b][/b][/b]<br /> Dim pt05(2) As Double<br /> <br /> Dim pt06(2) As Double<br /> <br /> Dim pt07(2) As Double<br /> <br /> Dim pt08(2) As Double<br /> <br /> Dim pt09(2) As Double<br /> <br /> Dim pt10(2) As Double<br /> <br /> <br /> Dim pt11(2) As Double<br /> <br /> Dim pt12(2) As Double<br /> <br /> Dim pt13(2) As Double<br /> <br /> Dim pt14(2) As Double<br /> <br /> Dim pt15(2) As Double<br /> <br /> Dim pt16(2) As Double<br /> <br /> Dim pt17(2) As Double<br /> <br /> Dim pt18(2) As Double<br /> <br /> Dim pt19(2) As Double<br /> <br /> Dim pt20(2) As Double<br /> <br /> <br /> Dim pt95(2) As Double<br /> <br /> Dim pt96(2) As Double<br /> <br /> <br /> <br /> <br /> pt01(0) = x: pt01(1) = y: pt01(2) = z<br /> <br /> pt02(0) = x: pt02(1) = y + 40: pt02(2) = z<br /> <br /> pt03(0) = x: pt03(1) = y + 47: pt03(2) = z<br /> <br /> pt04(0) = x: pt04(1) = y + 50: pt04(2) = z<br /> <br /> pt05(0) = x: pt05(1) = y + 57: pt05(2) = z<br /> <br /> pt06(0) = x + 3.3: pt06(1) = y + 57: pt06(2) = z<br /> <br /> pt07(0) = x + 3.3: pt07(1) = y + 50: pt07(2) = z<br /> <br /> pt08(0) = x + 8.9: pt08(1) = y + 50: pt08(2) = z<br /> <br /> pt09(0) = x + 8.9: pt09(1) = y + 47: pt09(2) = z<br /> <br /> pt10(0) = x + 40: pt10(1) = y + 47: pt10(2) = z<br /> <br /> pt11(0) = x + 40: pt11(1) = y + 40: pt11(2) = z<br /> <br /> pt12(0) = x + 90: pt12(1) = y + 40: pt12(2) = z<br /> <br /> pt13(0) = x + 90: pt13(1) = y: pt13(2) = z<br /> <br /> pt14(0) = x + 4.5: pt14(1) = y + 50: pt14(2) = z<br /> <br /> pt15(0) = x + 4.5: pt15(1) = y + 47: pt15(2) = z<br /> <br /> pt16(0) = x + 35: pt16(1) = y + 47: pt16(2) = z<br /> <br /> pt17(0) = x + 35: pt17(1) = y + 40: pt17(2) = z<br /> <br /> <br /> pt95(0) = x: pt95(1) = y + 75: pt95(2) = z<br /> <br /> pt96(0) = x: pt96(1) = y - zc - 613: pt96(2) = z<br /> <br /> <br /> <br /> <br /> Dim objLayer As AcadLayer<br /> <br /> Set objLayer = ThisDrawing.Layers.Add("粗实线")<br /> <br /> objLayer.color = acWhite<br /> <br /> objLayer.Linetype = "Continuous"<br /> <br /> objLayer.Lineweight = acLnWt030<br /> <br /> ThisDrawing.ActiveLayer = objLayer<br /> <br /> <br /> <br /> <br /> <br /> Set objline(1) = ThisDrawing.ModelSpace.AddLine(pt05, pt06)<br /> <br /> Set objline(2) = ThisDrawing.ModelSpace.AddLine(pt06, pt07)<br /> <br /> Set objline(3) = ThisDrawing.ModelSpace.AddLine(pt04, pt08)<br /> <br /> Set objline(4) = ThisDrawing.ModelSpace.AddLine(pt08, pt09)<br /> <br /> Set objline(5) = ThisDrawing.ModelSpace.AddLine(pt03, pt10)<br /> <br /> Set objline(6) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)<br /> <br /> Set objline(7) = ThisDrawing.ModelSpace.AddLine(pt02, pt12)<br /> <br /> Set objline(8) = ThisDrawing.ModelSpace.AddLine(pt12, pt13)<br /> <br /> Set objline(9) = ThisDrawing.ModelSpace.AddLine(pt01, pt13)<br /> <br /> Set objline(10) = ThisDrawing.ModelSpace.AddLine(pt14, pt15)<br /> <br /> Set objline(11) = ThisDrawing.ModelSpace.AddLine(pt16, pt17)<br /> <br /> <br /> <br /> <br /> Dim xhcs As Integer<br /> <br /> For xhcs = 1 To 11<br /> <br /> objline(xhcs).Mirror pt95, pt96<br /> <br /> Next<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> End Sub

点击按钮名为command_1的按钮即可调用