Translatecoordinates用法求助

marting

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

你的VBA代码是帮助里面的？ 你用的CAD版本是什么，下面是我在2019的VBA里面运行的帮助的代码，结果如下

变换了






---------------------------
TranslateCoordinates Example
---------------------------
The point has the following coordinates:

WCS: 1090.86014478392, 1980.06009680671, 2

UCS: 1088.86014478392, 1978.06009680671, 0
---------------------------
确定   
---------------------------

1. Sub 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. 
   
6.     AppActivate ThisDrawing.Application.Caption
   
7. 
   
8.     ' Create a UCS named "New_UCS" in current drawing
   
9.     Dim ucsObj As AcadUCS
   
10.     Dim origin(0 To 2) As Double
    
11.     Dim xAxisPnt(0 To 2) As Double
    
12.     Dim yAxisPnt(0 To 2) As Double
    
13. 
    
14.     ' Define the UCS
    
15.     origin(0) = 2#: origin(1) = 2#: origin(2) = 2#
    
16.     xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#
    
17.     yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#
    
18. 
    
19.     ' Add the UCS to the UserCoordinatesSystems collection
    
20.     Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    
21.     ThisDrawing.ActiveUCS = ucsObj
    
22. 
    
23.     ' Get the active viewport and make sure the UCS icon is on
    
24.     Dim viewportObj As AcadViewport
    
25.     Set viewportObj = ThisDrawing.ActiveViewport
    
26.     viewportObj.UCSIconOn = True
    
27.     viewportObj.UCSIconAtOrigin = True
    
28.     ThisDrawing.ActiveViewport = viewportObj
    
29. 
    
30.     ' Have the user enter a point
    
31.     Dim pointWCS As Variant
    
32.     pointWCS = ThisDrawing.Utility.GetPoint(, "Enter a point to translate:")
    
33. 
    
34.     ' Translate the point into UCS coordinates
    
35.     Dim pointUCS As Variant
    
36.     pointUCS = ThisDrawing.Utility.TranslateCoordinates(pointWCS, acWorld, acUCS, False)
    
37. 
    
38.     ' Display the coordinates of the point
    
39.     MsgBox "The point has the following coordinates:" & vbCrLf & _
    
40.            "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _
    
41.            "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Example"
    
42. 
    
43. End Sub
    

Sub 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 /> <br />     AppActivate ThisDrawing.Application.Caption<br /> <br />     ' Create a UCS named "New_UCS" in current drawing<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 /> <br />     ' Define the UCS<br />     origin(0) = 2#: origin(1) = 2#: origin(2) = 2#<br />     xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#<br />     yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#<br /> <br />     ' Add the UCS to the UserCoordinatesSystems collection<br />     Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")<br />     ThisDrawing.ActiveUCS = ucsObj<br /> <br />     ' Get the active viewport and make sure the UCS icon is on<br />     Dim viewportObj As AcadViewport<br />     Set viewportObj = ThisDrawing.ActiveViewport<br />     viewportObj.UCSIconOn = True<br />     viewportObj.UCSIconAtOrigin = True<br />     ThisDrawing.ActiveViewport = viewportObj<br /> <br />     ' Have the user enter a point<br />     Dim pointWCS As Variant<br />     pointWCS = ThisDrawing.Utility.GetPoint(, "Enter a point to translate:")<br /> <br />     ' Translate the point into UCS coordinates<br />     Dim pointUCS As Variant<br />     pointUCS = ThisDrawing.Utility.TranslateCoordinates(pointWCS, acWorld, acUCS, False)<br /> <br />     ' Display the coordinates of the point<br />     MsgBox "The point has the following coordinates:" & vbCrLf & _<br />            "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _<br />            "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Example"<br /> <br /> End Sub<br />

你对比下，和你的代码。

liujianzhong88

marting 发表于 2018-5-7 23:18
VBA资源那么少，为什么不改下其他语言呢，VLISP完全能用你上面的代码。下面是帮助手册的例子：

大哥，我现在的问题是，我是在EXCEL 上做的软件，现在是用EXCEL来调CAD画图的，CAD算出的点数据，我还要在调回到EXCEL里保存的。
EXCEL 好像不支持VLISP啊，望解答，谢谢 大神！

newer

liujianzhong88 发表于 2018-5-8 00:50
大哥，我现在的问题是，我是在EXCEL 上做的软件，现在是用EXCEL来调CAD画图的，CAD算出的点数据，我还要 ...

谁说VLISP不支持EXCEL，你用EXCEL 搜索论坛，一大堆函数和代码。

liujianzhong88

两位大神：
   求帮忙！

我发现问题了，我的代码直接在CAD上运行，结果是正确的，Translatecoordinates是有作用的，关键的是，我的代码是要在EXCEL上运行，由EXCEL来调用CAD 画图的，再将图的坐标点反馈到EXCEL中保存，可以同样的代码，在EXCEL中运行，TranslateCoordinates就没有作用，求解答！

newer

liujianzhong88 发表于 2018-5-8 09:45
两位大神：
   求帮忙！

点的变换，无非就是矩阵的变换，你不用CAD ACTIVEX提供给你的Translate，自己可以用矩阵去变换点，可以 搜索 矩阵，看看。

liujianzhong88

newer 发表于 2018-5-8 10:14
点的变换，无非就是矩阵的变换，你不用CAD ACTIVEX提供给你的Translate，自己可以用矩阵去变换点，可以  ...

有道理，谢谢，Translatecoordinates 用不了

我就获得的矩阵坐标点和我点的坐标点 相加减 谢谢谢谢谢