批量插入多段线

利用autocadvba功能

Public ii% '定义全局变量，ii

Sub DrawPL()
On Error Resume Next
Set ExcelApp = GetObject(, “excel.Application”)
If Err Then
Err.Clear
Set ExcelApp = CreateObject(“excel.application”)
If Err Then
MsgBox (“不能运行excel,检查是否安装了excel”)
Exit Sub
End If
End If

ExcelApp.Workbooks.Open “f:\CADTOOLS*****.xls”, , ReadOnly
ExcelApp.Visible = False
Dim i As Integer, tim As Date
tim = Timer
Dim ord() As Double
Dim arr() As Double
'Dim arr2() As Double
lastrownum = ExcelApp.ActiveWorkbook.Worksheets(“位置信息”).Range(“I65535”).End(3).row

‘’tempnum = ExcelApp.ActiveWorkbook.Worksheets("位置信息").Range("I65535").End(3)


For i = 2 To lastrownum - 1

If ExcelApp.ActiveWorkbook.Worksheets("位置信息").cells(i, "i") = 1 Then
Count = Count + 1
 End If
 Next i

MsgBox “总共拐点号为1的个数为” & Count '测试总共个数
ReDim ord(0 To Count) As Double
j = 0
i = 0
For i = 2 To lastrownum

    If ExcelApp.ActiveWorkbook.Worksheets("位置信息").cells(i, "i") = 1 Then

    'ord(j) = ExcelApp.ActiveWorkbook.Worksheets("位置信息").cells(i - 1, "i")
    ord(j) = i
 j = j + 1

End If

Next i

MsgBox “查ord()数组上界” & UBound(ord) '查数组的上界，数组总数得加1
‘’ For mn = 0 To UBound(ord)
‘’
‘’ n = ord(mn)
‘’ MsgBox “拐点号为1所在的行数为” & n '查拐点号所在行数
ii = 2
For p = 0 To UBound(ord)
If p <= j - 2 Then '更改拐点号为1的总数
pp = ord(p + 1) - ord§

        ReDim arr(0 To pp * 2 - 1) As Double
        s = 0
        If s < pp * 2 - 2 Then

        For ii = ii To ord(p + 1) - 1
            arr(s) = ExcelApp.ActiveWorkbook.Worksheets("位置信息").Range("k" & ii)
            arr(s + 1) = ExcelApp.ActiveWorkbook.Worksheets("位置信息").Range("j" & ii)
            s = s + 2
             Next ii
        ThisDrawing.ModelSpace.AddLightWeightPolyline arr

        End If

End If
Next p
‘’ Next mn

    ExcelApp.Workbooks.Close
    ExcelApp.Quit
    ThisDrawing.Application.Update
    ZoomExtents
    MsgBox "耗时：" & Format(Timer - tim, "0.00") & 秒

End Sub