[求助]关于获取样条曲线的拟合点问题（附代码）
<p>大侠们好！我现在已有一张CAD图，想通过VBA实现获取里面的所有样条曲线的拟合点的坐标，我的代码如下：</p><p>Sub Select_GetFitPoint()<br/> ' This example selects a spline object in model space.<br/> ' It then finds the coordinates of the fit points.</p><p> ' select the spline<br/> ' 创建新的选择集</p><p> Dim ssetObj As AcadSelectionSet<br/> 'Dim splineObj As AcadSpline</p><p><br/> Set ssetObj = ThisDrawing.SelectionSets.Add("SSpline")<br/> <br/> '构建过滤器<br/> Dim fType As Variant, fData As Variant<br/> Call CreateSSetFilter(fType, fData, 0, "Spline")</p><p><br/> ' 提示用户选择样条曲线对象并将它们添加到选择集中。</p><p> ' 要完成选择，按回车。<br/> <br/> ssetObj.SelectOnScreen fType, fData</p><p> ZoomAll<br/> <br/> ' Display the coordinates of the fit points<br/> Dim fitPoint As Variant<br/> Dim index As Integer<br/> For index = 0 To ssetObj.NumberOfFitPoints - 1<br/> fitPoint = ssetObj.GetFitPoint(index)<br/> MsgBox "Fit point " & index + 1 & " is at " & fitPoint(0) & ", " & fitPoint(1) & ", " & fitPoint(2), , "GetFitPoint Example"<br/> Next<br/> <br/>End Sub<br/>' 创建选择集过滤器<br/>Public Sub CreateSSetFilter(ByRef filterType As Variant, ByRef filterData As Variant, ParamArray filter())<br/> If UBound(filter) Mod 2 = 0 Then<br/> MsgBox "filter参数无效！"<br/> Exit Sub<br/> End If<br/> <br/> Dim fType() As Integer ' 过滤器规则<br/> Dim fData() As Variant ' 过滤器参数<br/> Dim count As Integer<br/> count = (UBound(filter) + 1) / 2<br/> ReDim fType(count - 1)<br/> ReDim fData(count - 1)<br/> <br/> Dim i As Integer<br/> For i = 0 To count - 1<br/> fType(i) = filter(2 * i)<br/> fData(i) = filter(2 * i + 1)<br/> Next i<br/> <br/> filterType = fType<br/> filterData = fData<br/>End Sub</p><p>调试发现ssetObj对象不能调用GetFitPoint()这个方法，请问应该怎么改代码呢？谢谢！</p> <p>....</p><p> For i = 0 To ssetObj.count - 1<br/> For index = 0 To ssetObj(i).NumberOfFitPoints - 1<br/> fitPoint = ssetObj(i).GetFitPoint(index)<br/> MsgBox "Fit point " & index + 1 & " is at " & fitPoint(0) & ", " & fitPoint(1) & ", " & fitPoint(2), , "GetFitPoint Example"<br/> Next<br/> Next</p><p>....</p>
页:
[1]