为什么我的VBA程序会很慢，对象创建后要清除吗？如何清除呢？

jacdy

为什么我的VBA程序会很慢，对象创建后要清除吗？如何清除呢？

xinghesnak

具体点说。。。。。。

jacdy

我是先建一个表格头部，然后画线，每画一条线就在表格增加一行记录这条张两点的坐标和长度，当我画到20条左右的时候，就会很慢了，不知是为什么？

xinghesnak

把你的程序也贴上来吧。。。。。

jacdy

3.          Dim iPoint As Variant
4.          iPoint = ThisDrawing.Utility.GetPoint(, "Please specify table insert point:")
5.          Dim MyModelSpace As IAcadModelSpace2
6.          Set MyModelSpace = ThisDrawing.ModelSpace
7.          Dim tb As AcadTable
8.          Set tb = MyModelSpace.AddTable(iPoint, 2, 5, txtHeight * 2, txtHeight * 1.2)
9.          tb.HorzCellMargin = txtHeight / 2
10.          tb.VertCellMargin = txtHeight / 2
11.          tb.SetTextHeight acDataRow, txtHeight * 2
12.          tb.SetTextHeight acHeaderRow, txtHeight * 2
13.          tb.SetTextHeight acTitleRow, txtHeight * 2
14.          tb.SetAlignment acDataRow, acMiddleCenter
15.          tb.SetAlignment acHeaderRow, acMiddleCenter
16.          tb.SetAlignment acTitleRow, acMiddleCenter
17.          'tb.SetTextStyle acDataRow, "iStyle"
18.          'tb.SetTextStyle acHeaderRow, "iStyle"
19.          'tb.SetTextStyle acTitleRow, "iStyle"
20.          
21.          tb.SetRowHeight 0, txtHeight * 8
22.          tb.SetRowHeight 1, txtHeight * 8
23.         
24.          tb.SetColumnWidth 0, txtHeight * 2 * 5
25.          tb.SetColumnWidth 1, txtHeight * 2 * 12
26.          tb.SetColumnWidth 2, txtHeight * 2 * 12
27.          tb.SetColumnWidth 3, txtHeight * 2 * 10
28.          tb.SetColumnWidth 4, txtHeight * 2 * 10
29.          tb.SetText 0, 0, "WIRE LIST"
30.          tb.SetText 1, 0, "NO."
31.          tb.SetText 1, 1, "START POINT"
32.          tb.SetText 1, 2, "END POINT"
33.          tb.SetText 1, 3, "DISTANCE"
34.          tb.SetText 1, 4, "LENGTH"
35. Do While Num > 0
36.         ThisDrawing.Utility.InitializeUserInput 0, "D E"
37.         On Error Resume Next
38.         pt1 = ThisDrawing.Utility.GetPoint(, "Please specify first point[or (D=Delete last wire) or (E=Exit)]:")
39.         If Err.Number = -2145320928 Then
40.             Dim Sel As String
41.             Sel = ThisDrawing.Utility.GetInput
42.             If LCase(Sel) = "e" Then
43.                 Exit Do
44.             ElseIf LCase(Sel) = "d" Then
45.                 No = No - 1
46.                 objPline.Delete
47.                 objHatch.Delete
48.                 ThisDrawing.SendCommand "Erase" + vbCr + CStr(pt2(0)) + "," + CStr(pt2(1)) + vbCr + vbCr
49.                 tb.DeleteRows tb.Rows - 1, 1
50.                 pt1 = ThisDrawing.Utility.GetPoint(, "Please specify first point:")
51.             End If
52.         End If
53.         
54.         pt2 = ThisDrawing.Utility.GetPoint(pt1, "Please specify second point:")
55.            tb.InsertRows tb.Rows, txtHeight * 1.75, 1
56.             
57.             tb.SetText tb.Rows - 1, 0, CStr(No)
58.             
59.             Txt = CStr(Round(pt1(0), 5)) + " , " + CStr(Round(pt1(1), 5))
60.             If Left(Txt, 1) = "." Then Txt = "0" + Txt
61.             If tb.GetColumnWidth(1) < txtHeight * 2.5 * Len(Txt) Then
62.                 tb.SetColumnWidth 1, txtHeight * 2.5 * Len(Txt)
63.             End If
64.             tb.SetText tb.Rows - 1, 1, Txt
65.             
66.             Txt = CStr(Round(pt2(0), 5)) + " , " + CStr(Round(pt2(1), 5))
67.             If Left(Txt, 1) = "." Then Txt = "0" + Txt
68.             If tb.GetColumnWidth(2) < txtHeight * 2.5 * Len(Txt) Then
69.                 tb.SetColumnWidth 2, txtHeight * 2.5 * Len(Txt)
70.             End If
71.             tb.SetText tb.Rows - 1, 2, Txt
72.             
73.             Txt = CStr(Round(objPline.Length, 5))
74.             If Left(Txt, 1) = "." Then Txt = "0" + Txt
75.             If tb.GetColumnWidth(3) < txtHeight * 2 * Len(Txt) Then
76.                 tb.SetColumnWidth 3, txtHeight * 2 * Len(Txt)
77.             End If
78.             tb.SetText tb.Rows - 1, 3, Txt
80. No = No + 1
82. Loop

         Dim iPoint As Variant          iPoint = ThisDrawing.Utility.GetPoint(, "Please specify table insert point:")          Dim MyModelSpace As IAcadModelSpace2          Set MyModelSpace = ThisDrawing.ModelSpace          Dim tb As AcadTable          Set tb = MyModelSpace.AddTable(iPoint, 2, 5, txtHeight * 2, txtHeight * 1.2)          tb.HorzCellMargin = txtHeight / 2          tb.VertCellMargin = txtHeight / 2          tb.SetTextHeight acDataRow, txtHeight * 2          tb.SetTextHeight acHeaderRow, txtHeight * 2          tb.SetTextHeight acTitleRow, txtHeight * 2          tb.SetAlignment acDataRow, acMiddleCenter          tb.SetAlignment acHeaderRow, acMiddleCenter          tb.SetAlignment acTitleRow, acMiddleCenter          'tb.SetTextStyle acDataRow, "iStyle"          'tb.SetTextStyle acHeaderRow, "iStyle"          'tb.SetTextStyle acTitleRow, "iStyle"                    tb.SetRowHeight 0, txtHeight * 8          tb.SetRowHeight 1, txtHeight * 8                   tb.SetColumnWidth 0, txtHeight * 2 * 5          tb.SetColumnWidth 1, txtHeight * 2 * 12          tb.SetColumnWidth 2, txtHeight * 2 * 12          tb.SetColumnWidth 3, txtHeight * 2 * 10          tb.SetColumnWidth 4, txtHeight * 2 * 10          tb.SetText 0, 0, "WIRE LIST"          tb.SetText 1, 0, "NO."          tb.SetText 1, 1, "START POINT"          tb.SetText 1, 2, "END POINT"          tb.SetText 1, 3, "DISTANCE"          tb.SetText 1, 4, "LENGTH" Do While Num > 0         ThisDrawing.Utility.InitializeUserInput 0, "D E"         On Error Resume Next         pt1 = ThisDrawing.Utility.GetPoint(, "Please specify first point[or (D=Delete last wire) or (E=Exit)]:")         If Err.Number = -2145320928 Then             Dim Sel As String             Sel = ThisDrawing.Utility.GetInput             If LCase(Sel) = "e" Then                 Exit Do             ElseIf LCase(Sel) = "d" Then                 No = No - 1                 objPline.Delete                 objHatch.Delete                 ThisDrawing.SendCommand "Erase" + vbCr + CStr(pt2(0)) + "," + CStr(pt2(1)) + vbCr + vbCr                 tb.DeleteRows tb.Rows - 1, 1                 pt1 = ThisDrawing.Utility.GetPoint(, "Please specify first point:")             End If         End If                  pt2 = ThisDrawing.Utility.GetPoint(pt1, "Please specify second point:")            tb.InsertRows tb.Rows, txtHeight * 1.75, 1                          tb.SetText tb.Rows - 1, 0, CStr(No)                          Txt = CStr(Round(pt1(0), 5)) + " , " + CStr(Round(pt1(1), 5))             If Left(Txt, 1) = "." Then Txt = "0" + Txt             If tb.GetColumnWidth(1) < txtHeight * 2.5 * Len(Txt) Then                 tb.SetColumnWidth 1, txtHeight * 2.5 * Len(Txt)             End If             tb.SetText tb.Rows - 1, 1, Txt                          Txt = CStr(Round(pt2(0), 5)) + " , " + CStr(Round(pt2(1), 5))             If Left(Txt, 1) = "." Then Txt = "0" + Txt             If tb.GetColumnWidth(2) < txtHeight * 2.5 * Len(Txt) Then                 tb.SetColumnWidth 2, txtHeight * 2.5 * Len(Txt)             End If             tb.SetText tb.Rows - 1, 2, Txt                          Txt = CStr(Round(objPline.Length, 5))             If Left(Txt, 1) = "." Then Txt = "0" + Txt             If tb.GetColumnWidth(3) < txtHeight * 2 * Len(Txt) Then                 tb.SetColumnWidth 3, txtHeight * 2 * Len(Txt)             End If             tb.SetText tb.Rows - 1, 3, Txt No = No + 1 Loop

雪山飞狐_lzh

2007里试过了,挺正常的:)

MJTD_7777

2006里也试过了,挺正常的:)

 

jacdy

可我在2005运行时，当我画了15条线后就变慢，越来越慢啊，我的机器是P42.8+512MB的HP原装机。