检查了好多遍都没有问题，可运行就是不行！

Sub test3Dto2D()
'创建选择集
Dim selset As AcadSelectionSet
Dim cor3 As Variant
Dim n As Integer
Dim a As Integer
a = 0
Set selset = ThisDrawing.SelectionSets.Add("sset")
selset.Select acSelectionSetAll         '遍历选择集并将每一个对象镜相
Dim entry As AcadObject
Dim pl As AcadLWPolylineFor Each entry In selset
     If entry.EntityName = "AcDb3dPolyline" Then
               cor3 = entry.Coordinates
               n = (UBound(cor3) + 1) * 2 / 3
               Dim pt() As Double
               ReDim pt(0 To n - 1) As Double                       For i = 0 To (n - 2) Step 2
                               pt(i) = cor3(a)
                               pt(i + 1) = cor3(a + 1)
                               a = a + 3
                       Next i
                       
               Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)
               entry.Delete
       End If
Next entryselset.Delete '避免下次重复End Sub

Sub tn = (UBound(cor3) + 1) * 2 / 3
               Dim pt() As Double
               ReDim pt(0 To n - 1) As Double
                       For i = 0 To (n - 2) Step 2