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

enocheasty · 发表于 2007-10-18 21:41:00

问题多多啊，望高人们帮助。
1，我们平常绘图的时候会转变WCS到自定义坐标系统，但这个坐标系统在UCS里面是未命名的，在我的绘图模型空间视口看到坐标图标已经变成用户坐标，所以我想问，要怎么样才能在我的程序启动的时候探测到目前视口的坐标系统已经不是WCS坐标系了！（我用thisdrawing.usercoordinatesystem.count 属性探测了一下发现数目是0，如果我在CAD里面把那个未命名UCS取个名字，再探测count就是1了！）
2，解决了上面的问题后，那么我自定义一个坐标对象后，要怎么样才能将当前的UCS信息赋值到我定义的坐标对象里面去呢？
3，再弱弱的问一下，当我们定义UCS时，我们选择了3点定义出来的UCS，和选择了一条直线定义出来的UCS有什么不同吗？说实话，我没有弄清帮助文档里面说的OCS是什么，它总是说用Poloyline还有一个别的什么玩意定义出来的OCS，但是我们平常选择一根直线也可以定义UCS啊。

alin · 发表于 2007-10-19 08:29:00

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