求救：这段代码引起的CAD崩溃
程序中有如下一段代码，运行后出现致命错误，如果注释这段代码，则无报错，请问这是什么原因？For i = 0 To sum - 1 Step 2
On Error Resume Next
For j = 1 To sum1 'j从1开始
If StrComp(xdata(i), .ShapeFields.Item(j).FieldName) = 0 Then
.ShapeFields.Item(j).Value = xdata(i + 1)
Exit For
End If
Next j
Next i
看样子，真正错误不在这段里。其它部份也帖出来吧，好象是数据库操作的错误。是不是数据库没有打开什么的？ 本帖最后由 xyz002 于 2011-6-7 17:03 编辑
代码如下：
Sub tt (PathStr As String, layer As String)
On Error Resume Next
Dim sset As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("ss")) Then
Set sset = ThisDrawing.SelectionSets.Item("ss")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("ss")
Dim fType(0) As Variant
Dim fData(0) As Variant
Dim obj As AcadBlockReference
fType(0) = 0
fData(0) = "INSERT"
sset.SelectOnScreen fType, fData
If sset.count > 0 Then
With MyShape
.OpenShape "c:\test.shp", shpCreate, shpPoint
Dim NewField As ShapeField
Set NewField = .ShapeFields.CreateField("SOUTH", shpText, 8)
Set NewField = .ShapeFields.CreateField("点号", shpText, 15)
Set NewField = .ShapeFields.CreateField("Z坐标", shpDouble, 15, 3)
.AppendFieldDefs
End With
For Each obj In sset
Dim PointCoor As Variant
PointCoor = obj.InsertionPoint
Dim xtype As Variant
Dim xdata As Variant
obj.GetXData "", xtype, xdata
If TypeName(xdata) <> "Empty" Then
Dim sum As Integer
sum = UBound(xdata) - LBound(xdata) + 1
With MyShape
Dim sum1 As Integer
sum1 = .ShapeFields.count
Dim i As Integer, j As Integer
For i = 0 To sum - 1 Step 2
On Error Resume Next
For j = 1 To sum1
If StrComp(xdata(i), .ShapeFields.Item(j).FieldName) = 0 Then
.ShapeFields.Item(j).Value = xdata(i + 1)
End If
Next j
Next i
Dim NewVert As Variant
Set NewVert = .Vertices.AddVertice(PointCoor(0), PointCoor(1))
.CreateShape
End With
End If
Next obj
End If
End Sub
程序运行时，更多的是reading错误：
有时候 一运行就关闭CAD窗口，这是什么类型的错误？
建议设断点试试吧，如果第一次或者前几次能循环过去，看看 xdata(i + 1)这个地方，有可能是他越界了
页:
[1]