循环中赋值出现的问题！

weixin7944 发表于 2006-8-10 14:12:00

Dim pt As Variant Dim kk As Integer kk = -1 Dim m As Integer Dim pt1(2) As Double pt = ThisDrawing.Utility.GetPoint(, "请输入插入点!")   For m = 1 To 30     kk = kk + 1  pt1(0) = pt(0) + 488: pt1(1) = pt(1) - 884 - (1500 * kk): pt1(2) = 0 .......
NEXT
当kk=1~22时，该程序运行正常；但是当kk=23,24,25,26,27,28,29,30时程序出现问题，pt1的坐标不再改变，此时pt1的坐标与kk=22时的坐标相同。真的很奇怪，请问高手这究竟是因为什么？谢谢！

fjfhgdwfn 发表于 2006-8-10 14:26:00

试试.for m=22 to 30
看看出现问题不?

weixin7944 发表于 2006-8-10 19:05:00

运行正常，包括for m=8 to 30也可以，好像这个 pt1(0) = pt(0) + 488: pt1(1) = pt(1) - 884 - (1500 * kk): pt1(2) = 0等式只能计算22次，真的很奇怪！
完整的程序如下：
Private Sub CommandButton4_Click() If (TextBox4.Text = "" Or TextBox5.Text = "") Then MsgBox "请输入起始位置！" Exit Sub End If Dim PathName As String         PathName = TextBox1.Text  On Error Resume Next   Set xlapp = GetObject(, "excel.application")   If Err Then   Err.Clear   Set xlapp = CreateObject("excel.application")   If Err Then   Err.Clear   MsgBox ("不能运行EXCEL，请检查是否安装了EXCEL")   Exit Sub   End If   End If  xlapp.Workbooks.Open PathName Dim pt As Variant Dim kk As Integer kk = -1 Dim m As Integer Dim textobject As AcadText Dim ts As AcadTextStyle     Dim ts1 As AcadTextStyle     Dim tsna As String Dim pt1(2) As Double Dim pt2(2) As Double Dim pt3(2) As Double Dim pt4(2) As Double Dim pt5(2) As Double Dim pt6(2) As Double Dim pt7(2) As Double frmMain.Hide pt = ThisDrawing.Utility.GetPoint(, "请输入插入点!")   For m = CInt(TextBox4.Text - 1) To CInt(TextBox5.Text - 1)     kk = kk + 1  pt1(0) = pt(0) + 488: pt1(1) = pt(1) - 884 - (1500 * kk): pt1(2) = 0 pt2(0) = pt(0) + 1662: pt2(1) = pt(1) - 890 - (1500 * kk): pt2(2) = 0 pt3(0) = pt(0) + 10548: pt3(1) = pt(1) - 752 - (1500 * kk): pt3(2) = 0 pt4(0) = pt(0) + 10589: pt4(1) = pt(1) - 1250 - (1500 * kk): pt4(2) = 0 pt5(0) = pt(0) + 10603: pt5(1) = pt(1) - 884 - (1500 * kk): pt5(2) = 0 pt6(0) = pt(0) + 25479: pt6(1) = pt(1) - 984 - (1500 * kk): pt6(2) = 0 pt7(0) = pt(0) + 26467: pt7(1) = pt(1) - 965 - (1500 * kk): pt7(2) = 0 Select Case (ComboBox2.Text)     Case Is = "中文" Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("a" & (m + 3)), pt1, 500) Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("b" & (m + 3)), pt2, 400) Set ts = ThisDrawing.ActiveTextStyle tsna = ts.fontFile     Set ts1 = ThisDrawing.ActiveTextStyle     ts1.fontFile = "HZTXT" ThisDrawing.ActiveTextStyle = ts1 Set textobject = ThisDrawing.ModelSpace.AddText((xlapp.Worksheets("sheet1").range("d" & (m + 3)) & xlapp.Worksheets("sheet1").range("e" & (m + 3))), pt5, 500) ThisDrawing.Regen acActiveViewport ts.fontFile = tsna ThisDrawing.ActiveTextStyle = ts Set textobject = ThisDrawing.ModelSpace.AddText("0", pt6, 400) Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("g" & (m + 3)), pt7, 550)     Case Is = "中英文" Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("a" & (m + 3)), pt1, 500) Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("b" & (m + 3)), pt2, 400) Set ts = ThisDrawing.ActiveTextStyle tsna = ts.fontFile     Set ts1 = ThisDrawing.ActiveTextStyle     ts1.fontFile = "HZTXT" ThisDrawing.ActiveTextStyle = ts1 Set textobject = ThisDrawing.ModelSpace.AddText((xlapp.Worksheets("sheet1").range("c" & (m + 3)) & xlapp.Worksheets("sheet1").range("d" & (m + 3))), pt3, 500) ThisDrawing.Regen acActiveViewport ts.fontFile = tsna ThisDrawing.ActiveTextStyle = ts Set textobject = ThisDrawing.ModelSpace.AddText((xlapp.Worksheets("sheet1").range("e" & (m + 3)) & " " & xlapp.Worksheets("sheet1").range("f" & (m + 3))), pt4, 300) Set textobject = ThisDrawing.ModelSpace.AddText("0", pt6, 400) Set textobject = ThisDrawing.ModelSpace.AddText(xlapp.Worksheets("sheet1").range("g" & (m + 3)), pt7, 550)     End Select      Next   xlapp.activeworkbook.Save   xlapp.Workbooks.Close   xlapp.Quit   Set xlsheet = Nothing   Set xlbook = Nothing   Set xlapp = Nothing End Sub

页: [1]

明经CAD社区's Archiver

循环中赋值出现的问题！