[求助]请教此代码为何不能得到样条曲线拟合点的UCS坐标值，而只能得到其WCS坐标值？

edi-000

[求助]请教此代码为何不能得到样条曲线拟合点的UCS坐标值，而只能得到其WCS坐标值？谢谢[br]

Sub test_AddOrgUCS()
    '原点UCS调用示例
    Dim myUCS As AcadUCS, NewOrgPt As Variant
    NewOrgPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "请输入新原点：")
    Set myUCS = AddOrgUCS(NewOrgPt, "abc")
    ThisDrawing.ActiveUCS = myUCS
     ' This example selects a spline object in model space.
    ' It then finds the coordinates of the fit points.

    Dim ssetObj As AcadSelectionSet

    Set ssetObj = ThisDrawing.SelectionSets.Add("SSpline")

    Dim fType As Variant, fData As Variant
    Call CreateSSetFilter(fType, fData, 0, "Spline")

    ' 提示用户选择样条曲线对象并将它们添加到选择集中。

    ' 要完成选择，按回车。
   
    ssetObj.SelectOnScreen fType, fData

    ZoomAll
   
    ' Display the coordinates of the fit points
    Dim fitPoint As Variant
    Dim index As Integer
    For i = 0 To ssetObj.count - 1
    For index = 0 To ssetObj(i).NumberOfFitPoints - 1
        fitPoint = ssetObj(i).GetFitPoint(index)
        MsgBox "拟合点" & index + 1 & " 的坐标为： " & fitPoint(0) & ", " & fitPoint(1) & ", " & fitPoint(2), , "GetFitPoint Example"
    Next
    Next
   
End Sub

Public Sub CreateSSetFilter(ByRef filterType As Variant, ByRef filterData As Variant, ParamArray filter())
    If UBound(filter) Mod 2 = 0 Then
        MsgBox "filter参数无效！"
        Exit Sub
    End If
   
    Dim fType() As Integer
    Dim fData() As Variant
    Dim count As Integer
    count = (UBound(filter) + 1) / 2
    ReDim fType(count - 1)
    ReDim fData(count - 1)
   
    Dim i As Integer
    For i = 0 To count - 1
        fType(i) = filter(2 * i)
        fData(i) = filter(2 * i + 1)
    Next i
   
    filterType = fType
    filterData = fData
End Sub

' 移动原点创建UCS
' ptOriginWcs：新UCS的原点在WCS中的坐标
Public Function AddOrgUCS(ptOriginWcs As Variant, strUcsName As String) As AcadUCS
    ' 获得新UCS原点在当前UCS中的坐标
    Dim ptOriginUcs As Variant
    ptOriginUcs = PtWcs2Ucs(ptOriginWcs)
    'Debug.Print ptOriginWcs(0)
    ' 获得X、Y正半轴上任一点的UCS坐标
    Dim ptXUcs(0 To 2) As Double, ptYUcs(0 To 2) As Double
    ptXUcs(0) = ptOriginUcs(0) + 1
    ptXUcs(1) = ptOriginUcs(1)
    ptXUcs(2) = ptOriginUcs(2)
    ptYUcs(0) = ptOriginUcs(0)
    ptYUcs(1) = ptOriginUcs(1) + 1
    ptYUcs(2) = ptOriginUcs(2)
   
    ' 获得X、Y正半轴上任一点的WCS坐标
    Dim ptXWcs As Variant, ptYWcs As Variant
    ptOriginWcs = PtUcs2Wcs(ptOriginUcs)
    ptXWcs = PtUcs2Wcs(ptXUcs)
    ptYWcs = PtUcs2Wcs(ptYUcs)
    'Debug.Print ptOriginWcs(0)
    ' 创建UCS
    Set AddOrgUCS = ThisDrawing.UserCoordinateSystems.Add(ptOriginWcs, ptXWcs, ptYWcs, strUcsName)
End Function

' 将点的UCS坐标转化到WCS坐标
Private Function PtUcs2Wcs(ptUcs As Variant) As Variant
    PtUcs2Wcs = ThisDrawing.Utility.TranslateCoordinates(ptUcs, acUCS, acWorld, False)
End Function

' 将点的WCS坐标转化到UCS坐标
Private Function PtWcs2Ucs(ptWcs As Variant) As Variant
    PtWcs2Ucs = ThisDrawing.Utility.TranslateCoordinates(ptWcs, acWorld, acUCS, False)
End Function