循环中赋值出现的问题！

weixin7944

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

试试.for m=22 to 30

看看出现问题不?

weixin7944

运行正常，包括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