|
|
急!如何把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 |
|
置顶卡
