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

gyl · 发表于 2003-10-9 00:55:00

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

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

mccad · 发表于 2003-10-9 06:57:00

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

mccad · 发表于 2003-10-9 06:59:00

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

gyl · 发表于 2003-10-9 12:37:00

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

efan2000 · 发表于 2003-10-9 12:45:00

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

gyl · 发表于 2003-10-9 13:40:00

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

copy


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