[求助]：请问如何在vba中获得ucs原点在世界坐标系中的坐标值大小

god

请问acad中建了一个ucs用户坐标系，如何在vba中获得ucs原点在世界坐标系中的坐标值大小，也就是得到两个坐标系间的关系。

eachy

getucsmatrix

god

请问eachy ，我太佩服你了，你是怎么找到想要的信息的？我就是不知道怎么做.

我在acad帮助中看到了GetUCSMatrix的例子。不过还是不知道怎么得到两个坐标系之间具体的数值关系，例子里面没有这些。是不是要用ucsObj.origin(0)，怎么得到ucs的转角呢？

efan2000

ucs的转角应该就是ucs的X方向的向量与原点的连线相对与X轴的角度。
ThisDrawing.Utility.AngleFromXAxis(ucsObj.origin, ucsObj.XVector)

god

请问，在VBA中通过objCircle.Center属性可得到图中的圆心坐标，不过只能得到世界坐标系中的坐标。如果要得到任意用户坐标系中的圆心坐标，要用到哪些函数及属性呢？用什么方法最简单？有没有现成的代码呢？

efan2000

使用TranslateCoordinates转化坐标
如：
pt=ThisDrawing.Utility.TranslateCoordinates(objCircle.Center, acWorld, acUCS, False)

r33d

1楼的问题：
Sub UcsOrg2Wcs()
    Dim UCSPnt(0 To 2) As Double
    Dim WCSPnt As Variant
    WCSPnt = ThisDrawing.Utility.TranslateCoordinates(UCSPnt, acUCS, acWorld, False)
    MsgBox WCSPnt(0) & "," & WCSPnt(1) & "," & WCSPnt(1), vbCritical  
End Sub
注意，UCSPnt在这里没有初始化，VBA自动初始化。

god

efan2000及各位高手，授人以鱼不如授人以渔。请问你们是怎么找到这些方法的？我觉得acad在线帮助中的信息量好高，倒是不好找。

7楼的方法很巧妙噢，看来是新来的高手，以后多指教哦

efan2000

在帮助文件中。
开发人员手册—在三维空间中工作—转换坐标。

2. 
   
3.   [FONT=courier new]
   
4. 转换坐标  
   
5. 
   
6. TranslateCoordinates 方法可以将点或位移从一个坐标系转换到另一个坐标系。称为 OriginalPoint 的点参数可以被解释为三维点或三维位移矢量。此参数由 Boolean 参数 Disp 来区分。如果 Disp 参数设置为 TRUE，OriginalPoint 参数将被视为位移矢量；否则视为点。还有两个参数用于确定 OriginalPoint 来自哪个坐标系以及要转换到哪个坐标系。可以在 From 和 To 参数中指定以下 AutoCAD 坐标系：
   
7. 
   
8. WCS
   
9. 
   
10. 世界坐标系 - 参照坐标系。所有其他坐标系都相对于 WCS 定义，该坐标系恒定不变。相对于 WCS 测量的值可以稳定地转换到其他坐标系中。除非另行指定，ActiveX 方法和特性传入和传出的所有点都以 WCS 表示。
    
11. 
    
12. UCS
    
13. 
    
14. 用户坐标系 - 工作坐标系。用户可以指定 UCS 以方便执行绘图任务。所有传递到 AutoCAD 命令的点，包括从 AutoLISP 例程以及外部函数返回的点，都是当前 UCS 中的点（除非用户于命令提示中在点之前加上了 *）。如果希望应用程序以 WCS、OCS 或 DCS 向 AutoCAD 命令发送坐标，必须先调用 TranslateCoordinates 方法，将这些坐标转换为 UCS。
    
15. 
    
16. OCS
    
17. 
    
18. 对象坐标系 - 由 Polyline 和 LightweightPolyline 对象的某些方法和特性指定的点值以此坐标系表示（相对于对象）。根据对象的用途，这些点通常会转换为 WCS、当前 UCS 或当前 DCS。相对地，WCS、UCS 或 DCS 中的点在使用相同的特性写入数据库之前，必须将其转换为 OCS。关于采用此坐标系的方法和特性，请参见 AutoCAD ActiveX and VBA Reference Guide。
    
19. 
    
20. 将坐标转换到 OCS 或从 OCS 转换坐标时，必须在 TranslateCoordinates 函数的最后一个参数中输入 OCS 的法线。
    
21. 
    
22. DCS
    
23. 
    
24. 显示坐标系 - 在显示对象之前将对象转换到的坐标系。DCS 的原点是存储在 AutoCAD 系统变量 TARGET 中的点，Z 轴是观察方向。也就是说，某个视口始终是其 DCS 的一个平面视图。这些坐标可用于确定显示给 AutoCAD 用户的画面的位置。
    
25. 
    
26. PSDCS
    
27. 
    
28. 图纸空间 DCS - 此坐标系只能与当前活动的模型空间视口的 DCS 互相转换。这种转换实质上是一种二维转换，其中的 X 和 Y 坐标在 Disp 参数设置为 FALSE 时，始终要进行缩放和偏移。Z 坐标也要缩放，但并不转换。因此，它可用于确定两个坐标系之间的缩放比例。PSDCS 只能转换到当前的模型空间视口中。如果 from 参数等于 PSDCS，则 to 参数必须等于 DCS，反之亦然。
    
29. 
    
30. 
    
31. 代码示例
    
32. 
    
33. 创建新的 UCS，将其激活，并将一个点的坐标转换为 UCS 坐标  
    
34. 
    
35. 下面的子例程将创建新的 UCS，并将其设置为图形的活动 UCS。然后要求用户在图形中拾取一点，并返回该点的 WCS 和 UCS 坐标。
    
36. 
    
37. Sub Ch8_NewUCS()
    
38.     ' 定义所需的变量
    
39.     Dim ucsObj As AcadUCS
    
40.     Dim origin(0 To 2) As Double
    
41.     Dim xAxisPnt(0 To 2) As Double
    
42.     Dim yAxisPnt(0 To 2) As Double
    
43.     ' 定义 UCS 点
    
44.     origin(0) = 4: origin(1) = 5: origin(2) = 3
    
45.     xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3
    
46.     yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3
    
47.    
    
48.     ' 将 UCS 添加到
    
49.     ' UserCoordinatesSystems 集合
    
50.     Set ucsObj = ThisDrawing.UserCoordinateSystems. _
    
51.              Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    
52.     ' 显示 UCS 图标
    
53.     ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
    
54.     ThisDrawing.ActiveViewport.UCSIconOn = True
    
55.    
    
56.     ' 使新的 UCS 成为活动的 UCS
    
57.     ThisDrawing.ActiveUCS = ucsObj
    
58.     MsgBox "The current UCS is : " & ThisDrawing.ActiveUCS.Name _
    
59.             & vbCrLf & " Pick a point in the drawing."
    
60.         
    
61.     ' 找出某一点的 WCS 和 UCS 坐标
    
62.     Dim WCSPnt As Variant
    
63.     Dim UCSPnt As Variant
    
64.    
    
65.     WCSPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
    
66.     UCSPnt = ThisDrawing.Utility.TranslateCoordinates _
    
67.              (WCSPnt, acWorld, acUCS, False)
    
68.    
    
69.     MsgBox "The WCS coordinates are: " & WCSPnt(0) & ", " _
    
70.              & WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf & _
    
71.              "The UCS coordinates are: " & UCSPnt(0) & ", " _
    
72.              & UCSPnt(1) & ", " & UCSPnt(2)
    
73. End Sub
    
74. 
    
75.   [/FONT]
    

<br />   [FONT=courier new]<br /> 转换坐标  <br /> <br /> TranslateCoordinates 方法可以将点或位移从一个坐标系转换到另一个坐标系。称为 OriginalPoint 的点参数可以被解释为三维点或三维位移矢量。此参数由 Boolean 参数 Disp 来区分。如果 Disp 参数设置为 TRUE，OriginalPoint 参数将被视为位移矢量；否则视为点。还有两个参数用于确定 OriginalPoint 来自哪个坐标系以及要转换到哪个坐标系。可以在 From 和 To 参数中指定以下 AutoCAD 坐标系： <br /> <br /> WCS <br /> <br /> 世界坐标系 - 参照坐标系。所有其他坐标系都相对于 WCS 定义，该坐标系恒定不变。相对于 WCS 测量的值可以稳定地转换到其他坐标系中。除非另行指定，ActiveX 方法和特性传入和传出的所有点都以 WCS 表示。 <br /> <br /> UCS <br /> <br /> 用户坐标系 - 工作坐标系。用户可以指定 UCS 以方便执行绘图任务。所有传递到 AutoCAD 命令的点，包括从 AutoLISP 例程以及外部函数返回的点，都是当前 UCS 中的点（除非用户于命令提示中在点之前加上了 *）。如果希望应用程序以 WCS、OCS 或 DCS 向 AutoCAD 命令发送坐标，必须先调用 TranslateCoordinates 方法，将这些坐标转换为 UCS。 <br /> <br /> OCS <br /> <br /> 对象坐标系 - 由 Polyline 和 LightweightPolyline 对象的某些方法和特性指定的点值以此坐标系表示（相对于对象）。根据对象的用途，这些点通常会转换为 WCS、当前 UCS 或当前 DCS。相对地，WCS、UCS 或 DCS 中的点在使用相同的特性写入数据库之前，必须将其转换为 OCS。关于采用此坐标系的方法和特性，请参见 AutoCAD ActiveX and VBA Reference Guide。 <br /> <br /> 将坐标转换到 OCS 或从 OCS 转换坐标时，必须在 TranslateCoordinates 函数的最后一个参数中输入 OCS 的法线。 <br /> <br /> DCS <br /> <br /> 显示坐标系 - 在显示对象之前将对象转换到的坐标系。DCS 的原点是存储在 AutoCAD 系统变量 TARGET 中的点，Z 轴是观察方向。也就是说，某个视口始终是其 DCS 的一个平面视图。这些坐标可用于确定显示给 AutoCAD 用户的画面的位置。 <br /> <br /> PSDCS <br /> <br /> 图纸空间 DCS - 此坐标系只能与当前活动的模型空间视口的 DCS 互相转换。这种转换实质上是一种二维转换，其中的 X 和 Y 坐标在 Disp 参数设置为 FALSE 时，始终要进行缩放和偏移。Z 坐标也要缩放，但并不转换。因此，它可用于确定两个坐标系之间的缩放比例。PSDCS 只能转换到当前的模型空间视口中。如果 from 参数等于 PSDCS，则 to 参数必须等于 DCS，反之亦然。 <br /> <br /> <br /> 代码示例<br /> <br /> 创建新的 UCS，将其激活，并将一个点的坐标转换为 UCS 坐标  <br /> <br /> 下面的子例程将创建新的 UCS，并将其设置为图形的活动 UCS。然后要求用户在图形中拾取一点，并返回该点的 WCS 和 UCS 坐标。 <br /> <br /> Sub Ch8_NewUCS()<br />     ' 定义所需的变量<br />     Dim ucsObj As AcadUCS<br />     Dim origin(0 To 2) As Double<br />     Dim xAxisPnt(0 To 2) As Double<br />     Dim yAxisPnt(0 To 2) As Double<br />     ' 定义 UCS 点<br />     origin(0) = 4: origin(1) = 5: origin(2) = 3<br />     xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3<br />     yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3<br />     <br />     ' 将 UCS 添加到<br />     ' UserCoordinatesSystems 集合<br />     Set ucsObj = ThisDrawing.UserCoordinateSystems. _<br />              Add(origin, xAxisPnt, yAxisPnt, "New_UCS")<br />     ' 显示 UCS 图标<br />     ThisDrawing.ActiveViewport.UCSIconAtOrigin = True<br />     ThisDrawing.ActiveViewport.UCSIconOn = True<br />     <br />     ' 使新的 UCS 成为活动的 UCS<br />     ThisDrawing.ActiveUCS = ucsObj<br />     MsgBox "The current UCS is : " & ThisDrawing.ActiveUCS.Name _<br />             & vbCrLf & " Pick a point in the drawing."<br />         <br />     ' 找出某一点的 WCS 和 UCS 坐标<br />     Dim WCSPnt As Variant<br />     Dim UCSPnt As Variant<br />     <br />     WCSPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")<br />     UCSPnt = ThisDrawing.Utility.TranslateCoordinates _<br />              (WCSPnt, acWorld, acUCS, False)<br />     <br />     MsgBox "The WCS coordinates are: " & WCSPnt(0) & ", " _<br />              & WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf & _<br />              "The UCS coordinates are: " & UCSPnt(0) & ", " _<br />              & UCSPnt(1) & ", " & UCSPnt(2)<br /> End Sub<br /> <br />   [/FONT]<br />

god

我懂了，谢谢efan