求大侠些，谁能看出来这些代码的快捷代码，感谢

354237695

Sub PlineToExcel()     'CAD多段线坐标至EXCEL表(采用当前UCS坐标系)
    '连接EXCEL
       Dim xlApp As Excel.Application
       Dim xlbook As Excel.Workbook
       Dim xlSheet As Excel.Worksheet
       On Error Resume Next
       Set xlApp = GetObject(, "excel.application")
       If Err <> 0 Then
         Err.Clear
         Set xlApp = CreateObject("excel.application")
         If Err <> 0 Then
           MsgBox "无法启动excel"
           Exit Sub
         End If
       End If
       If ActiveWorkbook.Sheets.Count = 0 Then xlbook = xlApp.Workbooks.Add
       Set xlbook = xlApp.ActiveWorkbook
       Set xlSheet = xlbook.ActiveSheet
        xlApp.Visible = True
        If Err <> 0 Then Err.Clear

Dim PickObj As AcadEntity         '保存被选择图元的对象变量
Dim PickPnt As Variant            '选择图元时的拾取点变量
Dim gpnt As Variant
Dim pntcnt As Integer
Dim UCSPnt As Variant, WCSPnt(0 To 2) As Double
    Dim Point As Variant
    Dim x0 As Double, y0 As Double, RadiusN As Double, BulgeN As Double
    Dim point_temp_x As Double, point_temp_y As Double
    Dim X() As Double, Y() As Double    '保存多义线的各点坐标的变量
    Dim EndPoint(0 To 2) As Double
    Dim Text As String
    Dim i As Integer, Ii As Integer, j As Long, k As Integer, l As Integer, m As Integer, n As Integer

    n = 1   'n为多段线编号
    l = 1

  Do
    Text = "请选择第 " & n & " 导线："
    ThisDrawing.Utility.GetEntity PickObj, PickPnt, Text
    '以下语句获取导线的顶点
    gpnt = PickObj.Coordinates
    pntcnt = UBound(gpnt)
    If Err <> 0 Then  '引入错误处理
      Exit Do
    End If

    If n = 1 Then
        Text = "选择第 " & n & " 导线的坐标原点：<0,0>"                 '设置默认原点为(0,0)点
        Point = PickPnt
        Point(0) = 0
        Point(1) = 0
    Else
        Text = "选择第 " & n & " 导线的坐标原点：<上一次选择的原点>"    '默认原点为 <上一次选择的原点>
    End If

    Point = ThisDrawing.Utility.GetPoint(, Text & vbCrLf)     '获取坐标原点
    '下一行是 将原点的 WCS 坐标值 转换成当前的 UCS坐标值
    UCSPnt = ThisDrawing.Utility.TranslateCoordinates(Point, acWorld, acUCS, False)
    x0 = UCSPnt(0)
    y0 = UCSPnt(1)

    If n = 1 Then                 '获取当前excel内的活动单元格信息
        If ActiveCell.Value <> "" Then m = MsgBox(" 您选择的单元格已有数据,是否替换相应内容？    " & Chr(13) & Chr(13) & "若不替换则跳转到excel中已使用区域的左下方输出", vbYesNo, "单元格非空，是否替换")
        If m = 7 Then
            l = ActiveCell.Column
            j = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
       Else
            l = ActiveCell.Column
            j = ActiveCell.Row - 1
        End If
    End If

    m = j + l * 3 - 2    '配置输出内容的字体颜色，不同钢束的颜色不一样
    If m > 56 Then
        Do
        m = m - 56
        Loop Until m < 56
    End If
    If m = 2 Or m = 19 Or m = 20 Or m = 36 Then m = m + 3

    If gpnt(0) < gpnt(2) Then      '判断多义线起始段x方向，若起始段坐标x值不递增，则读取导线点时反向读取
        Ii = -2:  k = 2
    Else
        Ii = pntcnt + 1: k = -2
    End If

    ReDim X(pntcnt + 1), Y(pntcnt + 1) '根据多段线端点个数定义动态数组大小

    For i = 0 To pntcnt - 1 Step 2  '导线的各点循环
        Ii = Ii + k

        WCSPnt(0) = gpnt(Ii): WCSPnt(1) = gpnt(Ii + 1): WCSPnt(2) = 0
        UCSPnt = ThisDrawing.Utility.TranslateCoordinates(WCSPnt, acWorld, acUCS, False) '将 WCS 坐标值 转换成当前的 UCS坐标值

        '计算第n段的曲线半径，直线返回 0 ，圆弧返回半径
        If i < pntcnt - 1 And k = 2 Then
            EndPoint(0) = gpnt(Ii + 2): EndPoint(1) = gpnt(Ii + 3): EndPoint(2) = 0
            BulgeN = PickObj.GetBulge(Ii / 2)
            RadiusN = GetArcRadius(WCSPnt, EndPoint, BulgeN)
        ElseIf i < pntcnt - 1 And k = -2 Then
            EndPoint(0) = gpnt(Ii - 2): EndPoint(1) = gpnt(Ii - 1): EndPoint(2) = 0
            BulgeN = PickObj.GetBulge(Ii / 2 - 1)
            RadiusN = GetArcRadius(WCSPnt, EndPoint, BulgeN)
        Else
            RadiusN = ""
        End If
        Err.Clear       '半径计算完毕

        X(i) = UCSPnt(0) - x0
        Y(i) = UCSPnt(1) - y0
        j = j + 1
       If i = 0 Then
         If n > 1 Then j = j + 1
         xlSheet.Cells(j, l) = n & "#多段线"
         xlSheet.Cells(j, l + 1) = "X坐标"
         xlSheet.Cells(j, l + 2) = "Y坐标"
         xlSheet.Cells(j, l + 3) = "i 子段" & vbCrLf & "曲线半径"
         xlSheet.Cells(j + 1, l) = i / 2 + 1
         xlSheet.Cells(j + 1, l + 1) = Format(X(i), "0.0000000000")
         xlSheet.Cells(j + 1, l + 2) = Format(Y(i), "0.0000000000")
         xlSheet.Cells(j + 1, l + 3) = Format(RadiusN, "0.0000000000")
         xlSheet.Cells(j, l).Font.ColorIndex = m
         xlSheet.Cells(j, l + 1).Font.ColorIndex = m
         xlSheet.Cells(j, l + 2).Font.ColorIndex = m
         xlSheet.Cells(j, l + 3).Font.ColorIndex = m
         xlSheet.Cells(j, l).HorizontalAlignment = xlCenter
         xlSheet.Cells(j, l + 1).HorizontalAlignment = xlCenter
         xlSheet.Cells(j, l + 2).HorizontalAlignment = xlCenter
         xlSheet.Cells(j, l + 3).HorizontalAlignment = xlCenter
       ElseIf i > 0 Then
         xlSheet.Cells(j + 1, l) = i / 2 + 1
         xlSheet.Cells(j + 1, l + 1) = Format(X(i), "0.0000000000")
         xlSheet.Cells(j + 1, l + 2) = Format(Y(i), "0.0000000000")
         xlSheet.Cells(j + 1, l + 3) = Format(RadiusN, "0.0000000000")
       End If
         xlSheet.Cells(j + 1, l).Font.ColorIndex = m
         xlSheet.Cells(j + 1, l + 1).Font.ColorIndex = m       '设置excel内数据颜色
         xlSheet.Cells(j + 1, l + 2).Font.ColorIndex = m
         xlSheet.Cells(j + 1, l + 3).Font.ColorIndex = m
         xlSheet.Cells(j + 1, l + 1).NumberFormat = "#0.000"   '设置excel内数据显示精度
         xlSheet.Cells(j + 1, l + 2).NumberFormat = "#0.000"
         xlSheet.Cells(j + 1, l + 3).NumberFormat = "#0.000"
    Next i
    xlSheet.Cells(j + 1, l + 3).Delete
    xlSheet.Cells(j + 2, l).Select   '选中导出的数据区域下方单元格，便于找到excel中的数据
    n = n + 1

  Loop Until pntcnt = 0

        Set xlSheet = xlbook.ActiveSheet
        xlApp.Visible = True

End Sub

Public Function GetArcRadius(PointS As Variant, PointE As Variant, Bulge As Double) As Double
    Dim Angle As Double
    Dim Length As Double
    Dim Dist As Double
    Dim i As Integer
    ' 计算起点到终点的长度
    For i = LBound(PointS) To UBound(PointS)
        Dist = Dist + ((PointS(i) - PointE(i)) ^ 2)
    Next

    Length = Sqr(Dist)
    If Bulge = 0 Then       ' 如果凸度为0，则为直线段，所以起点到终点的长度就是需要的长度
        GetArcRadius = 0
    Else
        Angle = 4 * Atn(Abs(Bulge))              ' 如果凸度不为零，则计算弧段的长度。按照凸度的定义，凸度为包角的1/4的正切值。
        GetArcRadius = (Length / 2) / Sin(Angle / 2)      ' 计算弧段的半径
    End If

End Function