在UCS下画线出现问题

lwd899

如题，为什么我第二次画的线和第三次画的线重合？代码如下：

'CAD
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Public Class Form1
    Dim AcadApp As AcadApplication
    Dim thisdrawing As AcadDocument
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
            AcadApp = GetObject("autocad.application")
        Catch ex As Exception
            Try
                AcadApp = CreateObject("autocad.application")
            Catch ex1 As Exception
                MsgBox("无法打开AutoCAD")
                Exit Sub
            End Try
        End Try
        AcadApp.Visible = True
        AppActivate(AcadApp.Caption)
        thisdrawing = AcadApp.ActiveDocument
        For i = 1 To 3
            Dim origin(0 To 2) As Double
            Call AddLine_UCS(1, 1, 0, 12, 12, 0)
            'Dim origin(0 To 2) As Double
            origin(0) = 8 : origin(1) = 8 : origin(2) = 0
            Call MoveOriginUCS(origin, "MyUcs")
        Next

    End Sub
    '通过移动坐标原点定义坐标系
    Public Function MoveOriginUCS(ByVal originWcs As Object, ByVal ucsName As String) As AcadUCS
        ' 获得新UCS原点在当前UCS中的坐标
        Dim originUcs As Object
        originUcs = TranslatePointWcsToUcs(originWcs)

        ' 获得X、Y正半轴上任一点的UCS坐标
        Dim ptXUcs(0 To 2) As Double, ptYUcs(0 To 2) As Double
        ptXUcs(0) = originUcs(0) + 1
        ptXUcs(1) = originUcs(1)
        ptXUcs(2) = originUcs(2)
        ptYUcs(0) = originUcs(0)
        ptYUcs(1) = originUcs(1) + 1
        ptYUcs(2) = originUcs(2)

        ' 获得X、Y正半轴上任一点的WCS坐标
        Dim ptXWcs As Object, ptYWcs As Object
        originWcs = TranslatePointUcsToWcs(originUcs)
        ptXWcs = TranslatePointUcsToWcs(ptXUcs)
        ptYWcs = TranslatePointUcsToWcs(ptYUcs)

        ' 创建UCS
        MoveOriginUCS = thisdrawing.UserCoordinateSystems.Add(originWcs, ptXWcs, ptYWcs, ucsName)
        'MoveOriginUCS = thisdrawing.UserCoordinateSystems.Add(originUcs, ptXUcs, ptYUcs, ucsName)
        '' 显示 UCS 图标
        'thisdrawing.ActiveViewport.UCSIconAtOrigin = True
        'thisdrawing.ActiveViewport.UCSIconOn = True
        '' 使新的 UCS 成为活动的 UCS
        'thisdrawing.ActiveUCS = MoveOriginUCS
    End Function
    ' 将点的坐标从UCS转换到WCS
    Public Function TranslatePointUcsToWcs(ByVal ucsPoint As Object) As Object
        Debug.Assert(VarType(ucsPoint) = vbArray + vbDouble)
        Debug.Assert(LBound(ucsPoint) = 0 And UBound(ucsPoint) = 2)
        TranslatePointUcsToWcs = thisdrawing.Utility.TranslateCoordinates(ucsPoint, AcCoordinateSystem.acUCS, AcCoordinateSystem.acWorld, False)
    End Function

    ' 将点的坐标从WCS转换到UCS
    Public Function TranslatePointWcsToUcs(ByVal wcsPoint As Object) As Object
        Debug.Assert(VarType(wcsPoint) = vbArray + vbDouble)
        Debug.Assert(LBound(wcsPoint) = 0 And UBound(wcsPoint) = 2)
        TranslatePointWcsToUcs = thisdrawing.Utility.TranslateCoordinates(wcsPoint, AcCoordinateSystem.acWorld, AcCoordinateSystem.acUCS, False)
    End Function
    Public Function AddLine_UCS(ByVal p1x As Double, ByVal p1y As Double, ByVal p1z As Double, ByVal p2x As Double, ByVal p2y As Double, ByVal p2z As Double) As AcadLine
        ' 保存当前的UCS
        Dim curUcs As AcadUCS
        curUcs = GetActiveUCS()
        ' 返回到WCS
        thisdrawing.ActiveUCS = GetWCS()
        Dim ptStart(2) As Double
        Dim ptEnd(2) As Double
        ptStart(0) = p1x
        ptStart(1) = p1y
        ptStart(2) = p1z

        ptEnd(0) = p2x
        ptEnd(1) = p2y
        ptEnd(2) = p2z

        ' 在WCS中创建轻量多段线
        Dim objLine As AcadLine
        objLine = thisdrawing.ModelSpace.AddLine(ptStart, ptEnd)

        ' 恢复保存的UCS
        thisdrawing.ActiveUCS = curUcs

        ' 对长方体进行变换
        Dim transMatrix As Object
        transMatrix = curUcs.GetUCSMatrix()
        objLine.TransformBy(transMatrix)
        objLine.Update()

        AddLine_UCS = objLine
    End Function
    Public Function GetWCS() As AcadUCS
        ' 定义创建UCS的三个点
        Dim ptOrigin(2) As Double, ptXAxis(2) As Double, ptYAxis(2) As Double
        ptOrigin(0) = 0 : ptOrigin(1) = 0 : ptOrigin(2) = 0
        ptXAxis(0) = 1 : ptXAxis(1) = 0 : ptXAxis(2) = 0
        ptYAxis(0) = 0 : ptYAxis(1) = 1 : ptYAxis(2) = 0
        GetWCS = thisdrawing.UserCoordinateSystems.Add(ptOrigin, ptXAxis, ptYAxis, "WCS")
    End Function
    Public Function GetActiveUCS() As AcadUCS
        If thisdrawing.GetVariable("UCSNAME") = "" Then
            Dim ptOrigin(2) As Double       ' 要创建的UCS的原点
            Dim ptXAxis(2) As Double        ' UCS的X轴正半轴上一点
            Dim ptYAxis(2) As Double        ' UCS的Y轴正半轴上一点
            Dim xDir, yDir, org As Object  ' 当前UCS的参数

            ' 获得当前UCS的参数
            xDir = thisdrawing.GetVariable("UCSXDIR")
            yDir = thisdrawing.GetVariable("UCSYDIR")
            org = thisdrawing.GetVariable("UCSORG")

            ' UCS的原点
            ptOrigin(0) = org(0)
            ptOrigin(1) = org(1)
            ptOrigin(2) = org(2)

            ' 获得UCS的X轴正半轴上的一点
            ptXAxis(0) = org(0) + xDir(0)
            ptXAxis(1) = org(1) + xDir(1)
            ptXAxis(2) = org(2) + xDir(2)

            ' 获得UCS的Y轴正半轴上的一点
            ptYAxis(0) = org(0) + yDir(0)
            ptYAxis(1) = org(1) + yDir(1)
            ptYAxis(2) = org(2) + yDir(2)

            ' 创建和当前UCS重合的UCS
            GetActiveUCS = thisdrawing.UserCoordinateSystems.Add(ptOrigin, ptXAxis, ptYAxis, "MyUCS")

            thisdrawing.ActiveUCS = GetActiveUCS
        Else
            GetActiveUCS = thisdrawing.ActiveUCS
        End If
    End Function
End Class

lwd899

问题已经解决了！

crazylsp

楼上是怎么解决的啊？