急!如何把CAD中的数据导向已经存在的EXCEL文件中,并自动识别从第一行空行开始写数据

qinshuiqi

急!如何把CAD中的数据导向已经存在的EXCEL文件中,并自动识别从第一行空行开始写数据.[br]

请教高手.如何把CAD中的数据导向已经存在的EXCEL文件中,并自动识别从第一行空行开始写数据.另外还要实现在用户选择线条时,提示用户输入材料的型号,写在EXCEL文件的某一列.以下是我的程序,但我不会实现这几个功能,请高手教教我,谢谢了.

Sub main()
    Dim line As AcadLine
    Dim ftype(0) As Integer
    Dim fdata(0) As Variant
    Dim xcl As excel.Application
    Dim xclsheet As Object
    Dim xclworkbook As Object
    Dim p1 As Variant
   
    'qsy
    p1 = ThisDrawing.Utility.GetPoint
   
   
   
    Dim sset As AcadSelectionSet
   
    Set sset = ThisDrawing.SelectionSets.Add("SelectLine")
   
    ftype(0) = 0
    fdata(0) = "Line"
   
    sset.SelectOnScreen ftype, fdata
   
    If sset.Count > 0 Then
       
        Set xcl = New excel.Application
        Set xclworkbook = xcl.Workbooks.Add
        Set xclsheet = xcl.ActiveSheet
       
        Dim I As Integer
        Dim center_x As Double
        Dim center_y As Double
        Dim center_z As Double
       
        I = 0
       
        For Each line In sset
            xclsheet.Cells(1, 1).Value = "Line Element"
            xclsheet.Cells(1, 2).Value = "Center Point X"
            xclsheet.Cells(1, 3).Value = "Center Point Y"
            xclsheet.Cells(1, 4).Value = "Center Point Z"
            xclsheet.Cells(1, 5).Value = "Length"
            'msg = MsgBox(Str(line.StartPoint(0)) & ":" & Str(line.StartPoint(1)) & ":" & Str(line.StartPoint(2)), _
                         vbOKOnly, _
                         "Name")
            I = I + 1
           
            center_x = (line.StartPoint(0) + line.EndPoint(0)) / 2 - p1(0)
            center_y = (line.StartPoint(1) + line.EndPoint(1)) / 2 - p1(1)
            center_z = (line.StartPoint(2) + line.EndPoint(2)) / 2 - p1(2)
            
            xclsheet.Cells(1 + I, 1).Value = I
            xclsheet.Cells(1 + I, 2).Value = center_x
            xclsheet.Cells(1 + I, 3).Value = center_y
            xclsheet.Cells(1 + I, 4).Value = center_z
            xclsheet.Cells(1 + I, 5).Value = line.Length
        Next
        xclworkbook.SaveAs "D:\sample3.xls"
        xcl.Quit
    End If
    sset.Delete
End Sub