求助 VBA中坐标转换问题

aming001

以下是一段简单的vba程序代码

Sub Example_AddPolyline()
    ' This example creates a polyline in model space.

    Dim plineObj As AcadPolyline
    Dim points(0 To 14) As Double

    ' Define the 2D polyline points
    points(0) = 1: points(1) = 1: points(2) = 0
    points(3) = 1: points(4) = 2: points(5) = 0
    points(6) = 2: points(7) = 2: points(8) = 0
    points(9) = 3: points(10) = 2: points(11) = 0
    points(12) = 4: points(13) = 4: points(14) = 0

    ' Create a lightweight Polyline object in model space
    Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
    ZoomAll

End Sub
上面的程序是在cad本身的世界坐标系下生成的一条多段线，现在本人在cad中通过ucs命令移动了坐标系的原点，请问怎么样修改上面的程序使其在自己定义的坐标系下生成所需要的这条多段线呢？

请高手多指教！！！

woaishuijia

第一种方法:将顶点坐标数组逐点由UCS转换为WCS,再画线

1. Sub Example_AddPolyline()
   
2.     ' This example creates a polyline in model space.
   
3. 
   
4.     Dim plineObj As AcadPolyline
   
5.     Dim points(0 To 14) As Double
   
6. 
   
7.     ' Define the 2D polyline points
   
8.     points(0) = 1: points(1) = 1: points(2) = 0
   
9.     points(3) = 1: points(4) = 2: points(5) = 0
   
10.     points(6) = 2: points(7) = 2: points(8) = 0
    
11.     points(9) = 3: points(10) = 2: points(11) = 0
    
12.     points(12) = 4: points(13) = 4: points(14) = 0
    
13.    
    
14.     Dim P1(2) As Double, P2 As Variant, I As Integer
    
15.     For I = 0 To 12 Step 3
    
16.         P1(0) = points(I): P1(1) = points(I + 1): P1(2) = points(I + 2)
    
17.         P2 = ThisDrawing.Utility.TranslateCoordinates(P1, acUCS, acWorld, 0)
    
18.         points(I) = P2(0): points(I + 1) = P2(1): points(I + 2) = P2(2)
    
19.     Next
    
20. 
    
21.     ' Create a lightweight Polyline object in model space
    
22.     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
    
23.     ZoomAll
    
24. 
    
25. End Sub

Sub Example_AddPolyline()<br />     ' This example creates a polyline in model space.<br /> <br />     Dim plineObj As AcadPolyline<br />     Dim points(0 To 14) As Double<br /> <br />     ' Define the 2D polyline points<br />     points(0) = 1: points(1) = 1: points(2) = 0<br />     points(3) = 1: points(4) = 2: points(5) = 0<br />     points(6) = 2: points(7) = 2: points(8) = 0<br />     points(9) = 3: points(10) = 2: points(11) = 0<br />     points(12) = 4: points(13) = 4: points(14) = 0<br />     <br />     Dim P1(2) As Double, P2 As Variant, I As Integer<br />     For I = 0 To 12 Step 3<br />         P1(0) = points(I): P1(1) = points(I + 1): P1(2) = points(I + 2)<br />         P2 = ThisDrawing.Utility.TranslateCoordinates(P1, acUCS, acWorld, 0)<br />         points(I) = P2(0): points(I + 1) = P2(1): points(I + 2) = P2(2)<br />     Next<br /> <br />     ' Create a lightweight Polyline object in model space<br />     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)<br />     ZoomAll<br /> <br /> End Sub

第二种方法:先按WCS画线,再将其移动到UCS的相应位置.这种方法要求UCS要命名

1. Sub Example_AddPolyline()
   
2.     ' This example creates a polyline in model space.
   
3. 
   
4.     Dim plineObj As AcadPolyline
   
5.     Dim points(0 To 14) As Double
   
6. 
   
7.     ' Define the 2D polyline points
   
8.     points(0) = 1: points(1) = 1: points(2) = 0
   
9.     points(3) = 1: points(4) = 2: points(5) = 0
   
10.     points(6) = 2: points(7) = 2: points(8) = 0
    
11.     points(9) = 3: points(10) = 2: points(11) = 0
    
12.     points(12) = 4: points(13) = 4: points(14) = 0
    
13. 
    
14.     ' Create a lightweight Polyline object in model space
    
15.     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
    
16.    
    
17.     plineObj.TransformBy ThisDrawing.UserCoordinateSystems("UCS名称").GetUCSMatrix
    
18. 
    
19.     ZoomAll
    
20. 
    
21. End Sub

Sub Example_AddPolyline()<br />     ' This example creates a polyline in model space.<br /> <br />     Dim plineObj As AcadPolyline<br />     Dim points(0 To 14) As Double<br /> <br />     ' Define the 2D polyline points<br />     points(0) = 1: points(1) = 1: points(2) = 0<br />     points(3) = 1: points(4) = 2: points(5) = 0<br />     points(6) = 2: points(7) = 2: points(8) = 0<br />     points(9) = 3: points(10) = 2: points(11) = 0<br />     points(12) = 4: points(13) = 4: points(14) = 0<br /> <br />     ' Create a lightweight Polyline object in model space<br />     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)<br />     <br />     plineObj.TransformBy ThisDrawing.UserCoordinateSystems("UCS名称").GetUCSMatrix<br /> <br />     ZoomAll<br /> <br /> End Sub

aming001

谢谢高手的指点！能否直接points数组直接从WCS转换到UCS？

jsxygshh

占个位置，有时间学习