一个很奇怪的现象，求助大神指导
贴上源代码如下，问题是红色部分设了断点分段执行，生成的txt中会有数据，如果不分步执行，生成的txt就是空的，求教Private Sub getcorxy()
Const ds As Double = 30 '曲线上的取点间隔
Dim SsetObj As AcadSelectionSet '选择集对象
Dim SsetPoint As AcadSelectionSet '点选择集
Dim SsetName As String '选择集名称
Dim PointObj As AcadPoint'点对象
Dim CommandSTR As String
Dim Pt() As Double '点坐标
Dim i As Integer, j As Integer
Dim Num1 As Integer, Num2 As Integer
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant, dataCode As Variant
'选择集名称
SsetName = "PolyLine"
'建立选择集
On Error Resume Next
Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)
If Err Then
Set SsetObj = ThisDrawing.SelectionSets.Item(SsetName)
SsetObj.Clear
Err.Clear
End If
On Error GoTo 0
'将曲线添加到选择集
gpCode(0) = 0'表示过滤器是对象类型，图层名
dataValue(0) = "polyLine" ' 表示对象类型是“polyLine”
groupCode = gpCode
dataCode = dataValue
SsetObj.Select acSelectionSetAll, , , groupCode, dataCode
'打开文件用于存储曲线离散化后的点的坐标
Open "D:\curve.txt" For Output As #1
Num1 = SsetObj.Count
Print #1, "曲线数目：" & Num1
'选择集名称
SsetName = "PointSet"
'建立选择集
On Error Resume Next
Set SsetPoint = ThisDrawing.SelectionSets.Add(SsetName)
If Err Then
Set SsetPoint = ThisDrawing.SelectionSets.Item(SsetName)
SsetPoint.Clear
Err.Clear
End If
On Error GoTo 0
'将全部点添加到选择集
gpCode(0) = 0
dataValue(0) = "point"
groupCode = gpCode
dataCode = dataValue
Dim newlayer As AcadLayer '增加一个新图层放生成的点
Set newlayer = ThisDrawing.Layers.Add("DivPoint")
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("DivPoint")
'在曲线上每隔一定距离取一个点，依次将点的坐标写入文件
For i = 1 To Num1
CommandSTR = "(Handent """ & SsetObj.Item(i - 1).Handle & """)"
ThisDrawing.SendCommand "MEASURE" & vbCr & CommandSTR & vbCr & CStr(ds) & vbCr
SsetPoint.Select acSelectionSetAll, , , groupCode, dataCode
Num2 = SsetPoint.Count
If Num2 <> 0 Then
ReDim Pt(Num2 - 1, 2) As Double
For j = 0 To Num2 - 1
Set PointObj = SsetPoint.Item(j)
Pt(j, 0) = PointObj.Coordinates(0)
Pt(j, 1) = PointObj.Coordinates(1)
Pt(j, 2) = PointObj.Coordinates(2)
Next j
SsetPoint.Erase '删除选择集中所有图元
Print #1, "第" & i & "条曲线"
For j = 0 To Num2 - 1
Print #1, Format(Pt(j, 0), "0.000"); " "; Format(Pt(j, 1), "0.000"); " "; Format(Pt(j, 2), "0.000")
Next j
End If
Next i
Close 1
SsetObj.Delete
End Sub
gpCode(0) = 0'表示过滤器是对象类型，图层名
修改成
gpCode(0) = 8'表示过滤器是对象类型，图层名
页:
[1]