这次没有使用类模块,错误依旧(不一定每次都出错,且数据量越大越会出错):
- Sub GetAllLength()
- Dim SsetObj As AcadSelectionSet '选择集对象
- Dim SsetName As String '选择集名称
- Dim gpCode(0) As Integer
- Dim dataValue(0) As Variant
- Dim i As Integer
-
- Dim VL As Object
- Dim VLF As Object
- Dim sym As Object
- Dim ret As Variant
-
- ThisDrawing.SendCommand "(vl-load-com)" & vbCr
- Set VL = Application.GetInterfaceObject("VL.Application.1")
- Set VLF = VL.ActiveDocument.Functions
-
- '选择集名称
- SsetName = "SplineSet"
- '建立选择集
- 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"
- SsetObj.Select acSelectionSetAll, , , gpCode, dataValue
-
- '打开文件
- Open "D:\curve.txt" For Output As #1
- Print #1, "曲线数目:" & SsetObj.Count
-
- '将曲线长度写入文件
- For i = 1 To SsetObj.Count
- Set sym = VLF.Item("read").funcall("handle")
- ret = VLF.Item("set").funcall(sym, SsetObj.Item(i - 1).Handle)
- Set sym = VLF.Item("read").funcall("(setq curve (handent handle))")
- Set ret = VLF.Item("eval").funcall(sym)
- Set sym = VLF.Item("read").funcall("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))")
- ret = VLF.Item("eval").funcall(sym)
- Print #1, "第"; i; "条曲线长度: "; Format(ret, "0.000")
- Next i
-
- Close 1
- SsetObj.Delete
- Set VLF = Nothing
- Set VL = Nothing
-
- MsgBox "成功"
-
- End Sub
这是试验数据。 |