唐僧肉 发表于 2006-9-18 20:43:00

[VBA]如何得到当前文档的当前无名ucs的转换矩阵？

本帖最后由 作者 于 2006-9-19 14:39:20 编辑

rt

唐僧肉 发表于 2006-9-19 11:17:00

<P>autodesk的代码如下，按照原理应该可行，可惜坐标转换之后保存的OriginalUCS有错误。郁闷啊。</P>
<P>Sub Example_ActiveUCS1()<BR>&nbsp;&nbsp;&nbsp; ' This example returns the current saved UCS (or saves a new one dynamically)<BR>&nbsp;&nbsp;&nbsp; ' and then sets a new UCS.<BR>&nbsp;&nbsp;&nbsp; ' Finally, it returns the UCS to the previous setting.<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim newUCS As AcadUCS<BR>&nbsp;&nbsp;&nbsp; Dim currUCS As AcadUCS<BR>&nbsp;&nbsp;&nbsp; Dim origin(0 To 2) As Double<BR>&nbsp;&nbsp;&nbsp; Dim xAxis(0 To 2) As Double<BR>&nbsp;&nbsp;&nbsp; Dim yAxis(0 To 2) As Double<BR>&nbsp;&nbsp;&nbsp; Dim pnt As Variant<BR>&nbsp;&nbsp;&nbsp; ' Get the current saved UCS of the active document. If the current UCS is<BR>&nbsp;&nbsp;&nbsp; ' not saved, then add a new UCS to the UserCoordinateSystems collection<BR>&nbsp;&nbsp;&nbsp; If ThisDrawing.GetVariable("UCSNAME") = "" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Current UCS is not saved so get the data and save it<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With ThisDrawing<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set currUCS = .UserCoordinateSystems.Add( _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .GetVariable("UCSORG"), _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "OriginalUCS")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set currUCS = ThisDrawing.ActiveUCS&nbsp; 'current UCS is saved<BR>&nbsp;&nbsp;&nbsp; End If<BR>'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _<BR>'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>'<BR>pnt = ThisDrawing.GetVariable("UCSORG")</P>
<P>&nbsp;&nbsp;&nbsp; Debug.Print pnt(0); pnt(1); pnt(2)<BR>&nbsp;&nbsp;&nbsp; pnt = ThisDrawing.GetVariable("UCSXDIR")<BR>&nbsp;&nbsp;&nbsp; Debug.Print pnt(0); pnt(1); pnt(2)<BR>&nbsp;&nbsp;&nbsp; pnt = ThisDrawing.GetVariable("UCSYDIR")<BR>&nbsp;&nbsp;&nbsp; Debug.Print pnt(0); pnt(1); pnt(2)<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; pnt = ThisDrawing.Utility.TranslateCoordinates(ThisDrawing.GetVariable("UCSXDIR"), acUCS, acWorld, 0)</P>
<P>&nbsp;&nbsp;&nbsp; Debug.Print pnt(0); pnt(1); pnt(2)<BR>&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; pnt = ThisDrawing.Utility.TranslateCoordinates(ThisDrawing.GetVariable("UCSYDIR"), acUCS, acWorld, 0)</P>
<P>&nbsp;&nbsp;&nbsp; Debug.Print pnt(0); pnt(1); pnt(2)<BR>&nbsp;&nbsp;&nbsp;&nbsp; </P>
<P>&nbsp;</P>
<P><BR>&nbsp;&nbsp;&nbsp; MsgBox "The current UCS is " &amp; currUCS.Name, vbInformation, "ActiveUCS Example"</P>
<P>&nbsp;&nbsp;&nbsp; ' Create a UCS and make it current<BR>&nbsp;&nbsp;&nbsp; origin(0) = 0: origin(1) = 0: origin(2) = 0<BR>&nbsp;&nbsp;&nbsp; xAxis(0) = 1: xAxis(1) = 1: xAxis(2) = 0<BR>&nbsp;&nbsp;&nbsp; yAxis(0) = -1: yAxis(1) = 1: yAxis(2) = 0<BR>&nbsp;&nbsp;&nbsp; Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis, "TestUCS")<BR>&nbsp;&nbsp;&nbsp; ThisDrawing.ActiveUCS = newUCS<BR>&nbsp;&nbsp;&nbsp; MsgBox "The new UCS is " &amp; newUCS.Name, vbInformation, "ActiveUCS Example"</P>
<P>&nbsp;&nbsp;&nbsp; ' Reset the UCS to its previous setting<BR>&nbsp;&nbsp;&nbsp; ThisDrawing.ActiveUCS = currUCS<BR>&nbsp;&nbsp;&nbsp; MsgBox "The UCS is reset to " &amp; currUCS.Name, vbInformation, "ActiveUCS Example"<BR>End Sub</P>
<P>&nbsp;</P>
<P>&nbsp;</P>

唐僧肉 发表于 2006-9-19 14:19:00

<P>这样就好了。呵呵。小心autodesk蒙人。</P>
<P>&nbsp;</P>
<P>&nbsp;&nbsp;&nbsp; If ThisDrawing.GetVariable("UCSNAME") = "" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Current UCS is not saved so get the data and save it&nbsp;&nbsp; '.GetVariable("UCSORG"),<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With ThisDrawing<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set currUCS = .UserCoordinateSystems.Add( _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pnt1, _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .GetVariable("UCSXDIR"), _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .GetVariable("UCSYDIR"), _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "OriginalUCS")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; currUCS.origin = .GetVariable("UCSORG")</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set currUCS = ThisDrawing.ActiveUCS&nbsp; 'current UCS is saved<BR>&nbsp;&nbsp;&nbsp; End If<BR></P>
页: [1]
查看完整版本: [VBA]如何得到当前文档的当前无名ucs的转换矩阵？