[求助]请教此代码为何不能得到样条曲线拟合点的UCS坐标值，而只能得到其WCS坐标值？
[求助]请教此代码为何不能得到样条曲线拟合点的UCS坐标值，而只能得到其WCS坐标值？谢谢<p>Sub test_AddOrgUCS()<br/> '原点UCS调用示例<br/> Dim myUCS As AcadUCS, NewOrgPt As Variant<br/> NewOrgPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "请输入新原点：")<br/> Set myUCS = AddOrgUCS(NewOrgPt, "abc")<br/> ThisDrawing.ActiveUCS = myUCS<br/> ' This example selects a spline object in model space.<br/> ' It then finds the coordinates of the fit points.</p><p> Dim ssetObj As AcadSelectionSet</p><p> Set ssetObj = ThisDrawing.SelectionSets.Add("SSpline")</p><p> 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 i = 0 To ssetObj.count - 1<br/> For index = 0 To ssetObj(i).NumberOfFitPoints - 1<br/> fitPoint = ssetObj(i).GetFitPoint(index)<br/> MsgBox "拟合点" & index + 1 & " 的坐标为： " & fitPoint(0) & ", " & fitPoint(1) & ", " & fitPoint(2), , "GetFitPoint Example"<br/> Next<br/> Next<br/> <br/>End Sub</p><p>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>' 移动原点创建UCS<br/>' ptOriginWcs：新UCS的原点在WCS中的坐标<br/>Public Function AddOrgUCS(ptOriginWcs As Variant, strUcsName As String) As AcadUCS<br/> ' 获得新UCS原点在当前UCS中的坐标<br/> Dim ptOriginUcs As Variant<br/> ptOriginUcs = PtWcs2Ucs(ptOriginWcs)<br/> 'Debug.Print ptOriginWcs(0)<br/> ' 获得X、Y正半轴上任一点的UCS坐标<br/> Dim ptXUcs(0 To 2) As Double, ptYUcs(0 To 2) As Double<br/> ptXUcs(0) = ptOriginUcs(0) + 1<br/> ptXUcs(1) = ptOriginUcs(1)<br/> ptXUcs(2) = ptOriginUcs(2)<br/> ptYUcs(0) = ptOriginUcs(0)<br/> ptYUcs(1) = ptOriginUcs(1) + 1<br/> ptYUcs(2) = ptOriginUcs(2)<br/> <br/> ' 获得X、Y正半轴上任一点的WCS坐标<br/> Dim ptXWcs As Variant, ptYWcs As Variant<br/> ptOriginWcs = PtUcs2Wcs(ptOriginUcs)<br/> ptXWcs = PtUcs2Wcs(ptXUcs)<br/> ptYWcs = PtUcs2Wcs(ptYUcs)<br/> 'Debug.Print ptOriginWcs(0)<br/> ' 创建UCS<br/> Set AddOrgUCS = ThisDrawing.UserCoordinateSystems.Add(ptOriginWcs, ptXWcs, ptYWcs, strUcsName)<br/>End Function</p><p>' 将点的UCS坐标转化到WCS坐标<br/>Private Function PtUcs2Wcs(ptUcs As Variant) As Variant<br/> PtUcs2Wcs = ThisDrawing.Utility.TranslateCoordinates(ptUcs, acUCS, acWorld, False)<br/>End Function</p><p>' 将点的WCS坐标转化到UCS坐标<br/>Private Function PtWcs2Ucs(ptWcs As Variant) As Variant<br/> PtWcs2Ucs = ThisDrawing.Utility.TranslateCoordinates(ptWcs, acWorld, acUCS, False)<br/>End Function<br/></p>
页:
[1]