Translatecoordinates用法求助

liujianzhong88

各位大神：

   我想用 VBA代码获得点在UCS下的坐标，用translatecoordinates方法做的过程中，发现，从WCS到UCS，点的坐标没有变化，请教各位是什么情况啊？
   下面是原代码（搞了一个星期了，望大神指导,急急急）

Sub TranslateCoordinates_WCS2UCS()
  
    Dim ucsObj As Object
    Dim origin(0 To 2) As Double
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double
    Dim acadApp As Object, acadDoc As Object
      
    Set acadApp = GetObject(, "AutoCAD.Application") ' 获得已经打开的AutoCAD程序的句柄
    Set acadDoc = acadApp.ActiveDocument ' 获得AutoCAD中当前文件的句柄
'=========================================================================================      
      
    origin(0) = 2#: origin(1) = 2#: origin(2) = 2#
    xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#
    yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#
   
   
    Set ucsObj = acadDoc.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    acadDoc.ActiveUCS = ucsObj
'=========================================================================================   
   
    Dim viewportObj As Object
    Set viewportObj = acadDoc.ActiveViewport
    viewportObj.UCSIconOn = True
    viewportObj.UCSIconAtOrigin = True
    acadDoc.ActiveViewport = viewportObj
'=========================================================================================  
   
    Dim pointWCS As Variant
    pointWCS = acadDoc.Utility.GetPoint(, "Enter a point to translate:")
   
    Dim pointUCS As Variant
    pointUCS = acadDoc.Utility.TranslateCoordinates(pointWCS, acWorld, acUCS, False)
'=========================================================================================   
  
    MsgBox "The point has the following coordinates:" & vbCrLf & _
            "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _
            "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Example"
End Sub

newer

确定UCS已经设置了吗？

liujianzhong88

确定，我是单步运行的，运行一步，就确认一步，求大神指导

liujianzhong88

newer 发表于 2018-5-7 20:00
确定UCS已经设置了吗？

UCS确定已经建立，代码中 有建立UCS的部分，求大神指教

newer

liujianzhong88 发表于 2018-5-7 21:01
确定，我是单步运行的，运行一步，就确认一步，求大神指导

这样，你在ACAD里面先设置好UCS，然后执行你的代码，把设置UCS的部分注释掉，然后你看WCS点是否给你转换了。

liujianzhong88

newer 发表于 2018-5-7 21:05
这样，你在ACAD里面先设置好UCS，然后执行你的代码，把设置UCS的部分注释掉，然后你看WCS点是否给你转换 ...

按 您的方法试了，坐标还是一样的，(WCS 和UCS下的坐标)，不进行转换

translatecoordinates方法，难道还有别的道道吗？
望大神指教

newer

liujianzhong88 发表于 2018-5-7 21:38
按 您的方法试了，坐标还是一样的，(WCS 和UCS下的坐标)，不进行转换

translatecoordinates方法，难道 ...

你手工设置了UCS，那么：

pointWCS = acadDoc.Utility.GetPoint(, "Enter a point to translate:")

你用GETPOINT获得的点就是UCS下的，当然没变化了。GETPOINT拾取点是UCS下的点。

你反过来，求UCS->WCS的，你打印下WCS点，看是否变换了。

liujianzhong88

newer 发表于 2018-5-7 21:42
你手工设置了UCS，那么：

pointWCS = acadDoc.Utility.GetPoint(, "Enter a point to translate:")

我设置的UCS 原点是（2，2，0）的

在WCS坐标下，画了（10，10，0）的交点后，载入UCS后  才运行代码

getpoint命令执行后 ，我确认了结果，点的坐标就是（10，10，0）
可转换后坐标还是（10,10,0)


getpoint命令的解释好像就是只接受在WCS下的坐标，应该没有错，望大神帮忙再看看，每执行到关键点我都拍照确认了，求大神帮忙！

liujianzhong88

我反过来试试看，感谢

newer

liujianzhong88 发表于 2018-5-7 21:54
我设置的UCS 原点是（2，2，0）的

在WCS坐标下，画了（10，10，0）的交点后，载入UCS后  才运行代码

这样，你先手工把坐标系设置到UCS。
然后你变换 '(0 0 0) 到 WCS，看WCS结果是什么？ 一楼的代码，你只保留变换的部分，其他都删除。

liujianzhong88

newer 发表于 2018-5-7 21:57
你自己在ACAD下面，输入
(getpoint) 看看得到的是什么下的点。

大神啊，求帮忙，反过来我也试了，永远显示的结果都是在WCS下的坐标，

newer

liujianzhong88 发表于 2018-5-7 22:00
大神啊，求帮忙，反过来我也试了，永远显示的结果都是在WCS下的坐标，

这样，你先手工把坐标系设置到UCS。
然后你变换 '(0 0 0) 到 WCS，看WCS结果是什么？ 一楼的代码，你只保留变换的部分，其他都删除。

liujianzhong88

newer 发表于 2018-5-7 22:01
这样，你先手工把坐标系设置到UCS。
然后你变换 '(0 0 0) 到 WCS，看WCS结果是什么？ 一楼的代码，你只 ...

我按您的办法试了，WCS下的坐标还是（0，0，0，）UCS下的坐标（0，0，0）我是直接赋值的，
我查了郑立楷的书，GetPoint 采的点默认都是WCS下的
我该咋办啊？

帮帮忙啊

liujianzhong88

newer 发表于 2018-5-7 22:01
这样，你先手工把坐标系设置到UCS。
然后你变换 '(0 0 0) 到 WCS，看WCS结果是什么？ 一楼的代码，你只 ...

可以加个 联系方式吗？微信之类的，感谢！

marting

liujianzhong88 发表于 2018-5-7 22:15
我按您的办法试了，WCS下的坐标还是（0，0，0，）UCS下的坐标（0，0，0）我是直接赋值的，
我查了郑立楷 ...

VBA资源那么少，为什么不改下其他语言呢，VLISP完全能用你上面的代码。下面是帮助手册的例子：

1. (defun c:Example_TranslateCoordinates()
   
2.     ;; This example creates a UCS with an origin at 2, 2, 2.
   
3.     ;; Next, a point is entered by the user. The WCS and UCS
   
4.     ;; coordinates of that point are output in a Msgbox.
   
5.     (setq acadObj (vlax-get-acad-object))
   
6.     (setq doc (vla-get-ActiveDocument acadObj))
   
7. 
   
8.     ;; Create a UCS named "New_UCS" in current drawing
   
9.     ;; Define the UCS
   
10.     (setq origin (vlax-3d-point 2 2 2)
    
11.           xAxisPnt (vlax-3d-point 5 2 2)
    
12.           yAxisPnt (vlax-3d-point 2 6 2))
    
13.    
    
14.     ;; Add the UCS to the UserCoordinatesSystems collection
    
15.     (setq ucsObj (vla-Add (vla-get-UserCoordinateSystems doc) origin xAxisPnt yAxisPnt "New_UCS"))
    
16.     (vla-put-ActiveUCS doc ucsObj)
    
17.    
    
18.     ;; Get the active viewport and make sure the UCS icon is on
    
19.     (setq viewportObj (vla-get-ActiveViewport doc))
    
20.     (vla-put-UCSIconOn viewportObj :vlax-true)
    
21.     (vla-put-UCSIconAtOrigin viewportObj :vlax-true)
    
22.     (vla-put-ActiveViewport doc viewportObj)
    
23.    
    
24.     ;; Have the user enter a point
    
25.     (setq pointWCS (vlax-variant-value (vla-GetPoint (vla-get-Utility doc) nil "\nEnter a point to translate:")))
    
26.    
    
27.     ;; Translate the point into UCS coordinates
    
28.     (setq pointUCS (vlax-variant-value (vla-TranslateCoordinates (vla-get-Utility doc) pointWCS acWorld acUCS :vlax-false)))
    
29.    
    
30.     ;; Display the coordinates of the point
    
31.     (alert (strcat "The point has the following coordinates:"
    
32.                    "\nWCS: " (rtos (vlax-safearray-get-element pointWCS 0) 2) ", "
    
33.                              (rtos (vlax-safearray-get-element pointWCS 1) 2) ", "
    
34.                              (rtos (vlax-safearray-get-element pointWCS 2) 2)
    
35.                    "\nUCS: " (rtos (vlax-safearray-get-element pointUCS 0) 2) ", "
    
36.                              (rtos (vlax-safearray-get-element pointUCS 1) 2) ", "
    
37.                              (rtos (vlax-safearray-get-element pointUCS 2) 2)))
    
38. )
    

(defun c:Example_TranslateCoordinates()<br />     ;; This example creates a UCS with an origin at 2, 2, 2.<br />     ;; Next, a point is entered by the user. The WCS and UCS<br />     ;; coordinates of that point are output in a Msgbox.<br />     (setq acadObj (vlax-get-acad-object))<br />     (setq doc (vla-get-ActiveDocument acadObj))<br /> <br />     ;; Create a UCS named "New_UCS" in current drawing<br />     ;; Define the UCS<br />     (setq origin (vlax-3d-point 2 2 2)<br />           xAxisPnt (vlax-3d-point 5 2 2)<br />           yAxisPnt (vlax-3d-point 2 6 2))<br />     <br />     ;; Add the UCS to the UserCoordinatesSystems collection<br />     (setq ucsObj (vla-Add (vla-get-UserCoordinateSystems doc) origin xAxisPnt yAxisPnt "New_UCS"))<br />     (vla-put-ActiveUCS doc ucsObj)<br />     <br />     ;; Get the active viewport and make sure the UCS icon is on<br />     (setq viewportObj (vla-get-ActiveViewport doc))<br />     (vla-put-UCSIconOn viewportObj :vlax-true)<br />     (vla-put-UCSIconAtOrigin viewportObj :vlax-true)<br />     (vla-put-ActiveViewport doc viewportObj)<br />    <br />     ;; Have the user enter a point<br />     (setq pointWCS (vlax-variant-value (vla-GetPoint (vla-get-Utility doc) nil "\nEnter a point to translate:")))<br />     <br />     ;; Translate the point into UCS coordinates<br />     (setq pointUCS (vlax-variant-value (vla-TranslateCoordinates (vla-get-Utility doc) pointWCS acWorld acUCS :vlax-false)))<br />     <br />     ;; Display the coordinates of the point<br />     (alert (strcat "The point has the following coordinates:"<br />                    "\nWCS: " (rtos (vlax-safearray-get-element pointWCS 0) 2) ", "<br />                              (rtos (vlax-safearray-get-element pointWCS 1) 2) ", "<br />                              (rtos (vlax-safearray-get-element pointWCS 2) 2)<br />                    "\nUCS: " (rtos (vlax-safearray-get-element pointUCS 0) 2) ", "<br />                              (rtos (vlax-safearray-get-element pointUCS 1) 2) ", "<br />                              (rtos (vlax-safearray-get-element pointUCS 2) 2)))<br /> )<br />

你对比下你的代码。