求助 VBA中坐标转换问题
以下是一段简单的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命令移动了坐标系的原点，请问怎么样修改上面的程序使其在自己定义的坐标系下生成所需要的这条多段线呢？
请高手多指教！！！
第一种方法:将顶点坐标数组逐点由UCS转换为WCS,再画线
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
Dim P1(2) As Double, P2 As Variant, I As Integer
For I = 0 To 12 Step 3
P1(0) = points(I): P1(1) = points(I + 1): P1(2) = points(I + 2)
P2 = ThisDrawing.Utility.TranslateCoordinates(P1, acUCS, acWorld, 0)
points(I) = P2(0): points(I + 1) = P2(1): points(I + 2) = P2(2)
Next
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
ZoomAll
End Sub
第二种方法:先按WCS画线,再将其移动到UCS的相应位置.这种方法要求UCS要命名
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)
plineObj.TransformBy ThisDrawing.UserCoordinateSystems("UCS名称").GetUCSMatrix
ZoomAll
End Sub 谢谢高手的指点！能否直接points数组直接从WCS转换到UCS？ 占个位置，有时间学习
页:
[1]