这个程序用到VLAX类及曲线操作，为什么出错？

gyl

我想实现这样一个功能：搜索当前图形中的所有样条曲线，对于每条曲线，从起点开始，每隔一定距离取一个点，然后将点的坐标写入文件，即将连续的样条曲线离散化。因此，写了这个程序，程序中的类和求曲线长的函数以及取曲线上一个点坐标的函数都是从本版下载的，只有宏函数是自己编的。该程序极不稳定，偶尔可以运行成功，多数情况下显示一个只有一个红叉的空白错误框，CAD命令行显示“参数太少”；如果出错后再次运行此宏，CAD必定崩溃退出。程序和图形文件都在此，程序内有详细注释。希望各位高手帮忙看一下毛病究竟出在什么地方。

mccad

这种出错应属选择集的BUG。而不是曲线的错误。
记得2000版的SsetObj.Delete就有问题，再试试现在的2004版本，其实也有这个BUG，所以不要使用该方法来清除选择集，应改用其它方法。
如

1.     On Error Resume Next
   
2.     Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)
   
3.     If Err Then
   
4.         Set SsetObj = ThisDrawing.SelectionSets.Item(SsetName)
   
5.         SsetObj.Clear
   
6.         Err.Clear
   
7.     End If
   

复制代码

mccad

另外，最后一个点坐标你可以直接使用曲线类的终点，而不必计算总长，再使用总长来找到最后一点，这样可能会由于偏差页找不到点。
你虽然程序中引用了曲线类，但却没有用到。

gyl

对于曲线类的使用，我的确不太理解。站长能否简单介绍一下方法步骤，结合实例更好。什么地方可以找到这方面的资料啊？VBA的随机帮助里好象没有这部分内容。

efan2000

它是Visual Lisp提供的，在VBA中当然找不到了。
查看VL的帮助吧，其中以vlax开头，中间带有curve的几个函数就是它的说明了。

gyl

用曲线类重写了程序，错误依旧。毛病出在Pt = ObjCurve.GetPointAtDistance(dist)这一句，而且每次出错时写入文件的点数都不一样，有多有少。真是百思不得其解！

2. Sub GetPointAtSpline()
   
3. 
   
4.     Const ds As Double = 20          '曲线上的取点间隔
   
5.     Dim dist As Double               '点至曲线端点的距离
   
6.     Dim SsetObj As AcadSelectionSet  '选择集对象
   
7.     Dim SsetName As String           '选择集名称
   
8.     Dim LengthOfCurve As Double      '曲线全长
   
9.     Dim Pt As Variant                '点坐标
   
10.     Dim i As Integer, j As Integer, num As Integer
    
11. 
    
12.     Dim gpCode(0) As Integer
    
13.     Dim dataValue(0) As Variant
    
14.     Dim groupCode As Variant, dataCode As Variant
    
15.    
    
16.     ThisDrawing.SendCommand "(vl-load-com)" & vbCr
    
17.    
    
18.     '定义引用曲线类模块
    
19.     Dim ObjCurve As Curve
    
20.     Set ObjCurve = New Curve
    
21.    
    
22.     '选择集名称
    
23.     SsetName = "SplineSet"
    
24.     '建立选择集
    
25.     On Error Resume Next
    
26.     Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)
    
27.     If Err Then
    
28.         Set SsetObj = ThisDrawing.SelectionSets.Item(SsetName)
    
29.         SsetObj.Clear
    
30.         Err.Clear
    
31.     End If
    
32.     On Error GoTo 0
    
33.    
    
34.     '将全部样条曲线添加到选择集
    
35.     gpCode(0) = 0
    
36.     dataValue(0) = "Spline"
    
37.     groupCode = gpCode
    
38.     dataCode = dataValue
    
39.     SsetObj.Select acSelectionSetAll, , , groupCode, dataCode
    
40.    
    
41.     '打开文件用于存储样条曲线离散化后的点的坐标
    
42.     Open "D:\curve.txt" For Output As #1
    
43.     Print #1, "样条曲线数目：" & SsetObj.Count
    
44.    
    
45.     '在样条曲线上每隔一定距离取一个点，依次将点的坐标写入文件
    
46.     For i = 1 To SsetObj.Count
    
47.         Set ObjCurve.Entity = SsetObj.Item(i - 1)
    
48.         '取得曲线全长
    
49.         LengthOfCurve = ObjCurve.length
    
50.         '计算要分的整段数
    
51.         num = Int(LengthOfCurve / ds)
    
52.         Print #1, "第" & i & "样条曲线长度：" & LengthOfCurve & "    曲线点数：" & num + 2
    
53.         '起点
    
54.         Pt = ObjCurve.StartPoint
    
55.         Print #1, "1： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")
    
56.         '中间各点
    
57.         For j = 1 To num
    
58.             dist = ds * j
    
59.             Pt = ObjCurve.GetPointAtDistance(dist)
    
60.             Print #1, j + 1 & "： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")
    
61.         Next j
    
62.         '终点
    
63.         Pt = ObjCurve.EndPoint
    
64.         Print #1, num + 2 & "： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")
    
65.     Next i
    
66.     Close 1
    
67.     SsetObj.Delete
    
68.    
    
69.     MsgBox "坐标提取成功"
    
70.    
    
71. End Sub

Sub GetPointAtSpline()<br /> <br />     Const ds As Double = 20          '曲线上的取点间隔<br />     Dim dist As Double               '点至曲线端点的距离<br />     Dim SsetObj As AcadSelectionSet  '选择集对象<br />     Dim SsetName As String           '选择集名称<br />     Dim LengthOfCurve As Double      '曲线全长<br />     Dim Pt As Variant                '点坐标<br />     Dim i As Integer, j As Integer, num As Integer<br /> <br />     Dim gpCode(0) As Integer<br />     Dim dataValue(0) As Variant<br />     Dim groupCode As Variant, dataCode As Variant<br />     <br />     ThisDrawing.SendCommand "(vl-load-com)" & vbCr<br />     <br />     '定义引用曲线类模块<br />     Dim ObjCurve As Curve<br />     Set ObjCurve = New Curve<br />     <br />     '选择集名称<br />     SsetName = "SplineSet"<br />     '建立选择集<br />     On Error Resume Next<br />     Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)<br />     If Err Then<br />         Set SsetObj = ThisDrawing.SelectionSets.Item(SsetName)<br />         SsetObj.Clear<br />         Err.Clear<br />     End If<br />     On Error GoTo 0<br />     <br />     '将全部样条曲线添加到选择集<br />     gpCode(0) = 0<br />     dataValue(0) = "Spline"<br />     groupCode = gpCode<br />     dataCode = dataValue<br />     SsetObj.Select acSelectionSetAll, , , groupCode, dataCode<br />     <br />     '打开文件用于存储样条曲线离散化后的点的坐标<br />     Open "D:\curve.txt" For Output As #1<br />     Print #1, "样条曲线数目：" & SsetObj.Count<br />     <br />     '在样条曲线上每隔一定距离取一个点，依次将点的坐标写入文件<br />     For i = 1 To SsetObj.Count<br />         Set ObjCurve.Entity = SsetObj.Item(i - 1)<br />         '取得曲线全长<br />         LengthOfCurve = ObjCurve.length<br />         '计算要分的整段数<br />         num = Int(LengthOfCurve / ds)<br />         Print #1, "第" & i & "样条曲线长度：" & LengthOfCurve & "    曲线点数：" & num + 2<br />         '起点<br />         Pt = ObjCurve.StartPoint<br />         Print #1, "1： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")<br />         '中间各点<br />         For j = 1 To num<br />             dist = ds * j<br />             Pt = ObjCurve.GetPointAtDistance(dist)<br />             Print #1, j + 1 & "： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")<br />         Next j<br />         '终点<br />         Pt = ObjCurve.EndPoint<br />         Print #1, num + 2 & "： "; Format(Pt(0), "0.000"); " "; Format(Pt(1), "0.000"); " "; Format(Pt(2), "0.000")<br />     Next i<br />     Close 1<br />     SsetObj.Delete<br />     <br />     MsgBox "坐标提取成功"<br />     <br /> End Sub

zeng29

我VLAX类的那个程序我调试了很多次都没有问题?就是后面这段贴出来的程序用Curve类会出现
“参数太少"崩溃退出.

gyl

在我的机器上，两种程序出错的几率差不多。而且曲线越多，出错可能越大。会不会是因为同时装了2002和2004的缘故呢？

mccad

不是的，可能是内存的问题。

gyl

内存问题？硬件问题还是软件问题？