[求助]关于VBA控制UCS的问题

enocheasty

问题多多啊，望高人们帮助。

1，我们平常绘图的时候会转变WCS到自定义坐标系统，但这个坐标系统在UCS里面是未命名的，在我的绘图模型空间视口看到坐标图标已经变成用户坐标，所以我想问，要怎么样才能在我的程序启动的时候探测到目前视口的坐标系统已经不是WCS坐标系了！（我用thisdrawing.usercoordinatesystem.count 属性探测了一下发现数目是0，如果我在CAD里面把那个未命名UCS取个名字，再探测count就是1了！）

2，解决了上面的问题后，那么我自定义一个坐标对象后，要怎么样才能将当前的UCS信息赋值到我定义的坐标对象里面去呢？

3，再弱弱的问一下，当我们定义UCS时，我们选择了3点定义出来的UCS，和选择了一条直线定义出来的UCS有什么不同吗？说实话，我没有弄清帮助文档里面说的OCS是什么，它总是说用Poloyline还有一个别的什么玩意定义出来的OCS，但是我们平常选择一根直线也可以定义UCS啊。

alin

from help files

Sub Example_ActiveUCS()
    ' This example returns the current saved UCS (or saves a new one dynamically)
    ' and then sets a new UCS.
    ' Finally, it returns the UCS to the previous setting.
   
    Dim newUCS As AcadUCS
    Dim currUCS As AcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxis(0 To 2) As Double
    Dim yAxis(0 To 2) As Double
   
    ' Get the current saved UCS of the active document. If the current UCS is
    ' not saved, then add a new UCS to the UserCoordinateSystems collection
    If ThisDrawing.GetVariable("UCSNAME") = "" Then
        ' Current UCS is not saved so get the data and save it
        With ThisDrawing
            Set currUCS = .UserCoordinateSystems.Add( _
                            .GetVariable("UCSORG"), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
                            "OriginalUCS")
        End With
    Else
        Set currUCS = ThisDrawing.ActiveUCS  'current UCS is saved
    End If
   
    MsgBox "The current UCS is " & currUCS.Name, vbInformation, "ActiveUCS Example"
   
    ' Create a UCS and make it current
    origin(0) = 0: origin(1) = 0: origin(2) = 0
    xAxis(0) = 1: xAxis(1) = 1: xAxis(2) = 0
    yAxis(0) = -1: yAxis(1) = 1: yAxis(2) = 0
    Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis, "TestUCS")
    ThisDrawing.ActiveUCS = newUCS
    MsgBox "The new UCS is " & newUCS.Name, vbInformation, "ActiveUCS Example"
   
    ' Reset the UCS to its previous setting
    ThisDrawing.ActiveUCS = currUCS
    MsgBox "The UCS is reset to " & currUCS.Name, vbInformation, "ActiveUCS Example"
End Sub

alin

From system variable "WORDLUCS" you can detect if the current coord system is WCS

enocheasty

我试试看，能不能解决问题！

还是老大厉害，我在CAD的帮助文档里面翻来翻去就没看到这个Example

都是关于讲解UCS Translation ，都晕了！

Thankyou very much！

crazylsp

谢谢提示如何建UCS坐标系。

crazylsp

origin(0) = 0: origin(1) = 0: origin(2) = 0
    xAxis(0) = 1: xAxis(1) = 1: xAxis(2) = 0
    yAxis(0) = -1: yAxis(1) = 1: yAxis(2) = 0

我试了一下午当为变量时好像都无法建成UCS！