循环中赋值出现的问题！
Dim pt As VariantDim 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时的坐标相同。真的很奇怪，请问高手这究竟是因为什么？谢谢！
试试.for m=22 to 30
看看出现问题不?
运行正常，包括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]