'直线转化为样条曲线
Sub LineToSPline()
    Dim E  As AcadEntity
    Dim L  As AcadLine
    Dim StartTan(0 To 2) As Double '指定样条曲线的起点切向。
    Dim FitPoints(0 To 8) As Double '指定样条曲线的所有拟合点?
    Dim CenterP As Variant '直线中点
    Dim a(0 To 2) As Double '拟合样条曲线的端点和终点的方向
    Dim n As Long
    Dim i As Long
    Dim Sp As AcadSpline
    n = ThisDrawing.ModelSpace.Count
    For Each E In ThisDrawing.ModelSpace
        i = i + 1
        ThisDrawing.Utility.Prompt Int(i / n * 100) & "%" & vbCrLf
        DoEvents
        'ThisDrawing.Utility.Prompt L.ObjectName
        'If e.ObjectName = "AcDbLine" Then
        If TypeOf E Is AcadLine Then
            Set L = E
            
            CenterP = centerPoint(L.StartPoint, L.EndPoint)
            
            a(0) = L.StartPoint(0) - L.EndPoint(0)
            a(1) = L.StartPoint(1) - L.EndPoint(1)
            a(2) = L.StartPoint(1) - L.EndPoint(1)
            
            FitPoints(0) = L.StartPoint(0):     FitPoints(1) = L.StartPoint(1):     FitPoints(2) = L.StartPoint(2)
            FitPoints(3) = CenterP(0):          FitPoints(4) = CenterP(1):          FitPoints(5) = CenterP(2)
            FitPoints(6) = L.EndPoint(0) + 0.001:   FitPoints(7) = L.EndPoint(1) + 0.001:   FitPoints(8) = L.EndPoint(2)
            
            StartTan(0) = -a(0):      StartTan(1) = -a(1):      StartTan(2) = -a(2)
            
            Set Sp = ThisDrawing.ModelSpace.AddSpline(FitPoints, StartTan, StartTan)
            Sp.Layer = L.Layer
            Sp.color = L.color
            L.Delete
        End If
    Next E
End Sub

 '样条曲线转化为直线(针对上面函数转化后的样条曲线)
Sub SPlineToLine()
    Dim E  As AcadEntity
    Dim L  As AcadLine
    Dim SP As AcadSpline
    Dim StartP As Variant
    Dim EndP As Variant
    
    For Each E In ThisDrawing.ModelSpace
        'DoEvents
        'ThisDrawing.Utility.Prompt E.ObjectName
        If E.ObjectName = "AcDbSpline" Then
            Set SP = E
            
            StartP = SP.GetFitPoint(0)
            EndP = SP.GetFitPoint(2)
            
            Set L = ThisDrawing.ModelSpace.AddLine(StartP, EndP)
            L.Layer = SP.Layer
            L.color = SP.color
            SP.Delete
        End If
    Next E
End Sub