cad读取excel数据，求助啊

燕归来 · 发表于 2012-7-12 14:30:00

Sub cc100()
Dim cc(0 To 2) As Double
Dim dd(0 To 2) As Double
Dim ExcelApp As Excel.Application
'激活要与之通信的Excel应用程序
Dim excelsheet As Worksheet '定义工作表变量
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err 0 Then
Set ExcelApp = CreateObject("Excel.Applicationn")
End If
Set ExcelApp = CreateObject("excel.application") '激活excel程序
ExcelApp.Workbooks.Open ("F:\vb\123.xls") '打开工作薄
Set excelsheet = ExcelApp.ActiveWorkbook.Sheets("sheet1") '当前工作表为sheet1
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err 0 Then
Set ExcelApp = CreateObject("Excel.Applicationn")
End If
cc(0) = 1000
cc(1) = 1000
cc(2) = 0
dd(0) = Excel.Worksheets("sheet1").Range("A1").Value
dd(1) = Excel.Worksheets("sheet1").Range("A1").Value
dd(2) = 0
For i = 1 To 100 Step 10
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
Call ThisDrawing.ModelSpace.AddCircle(dd, i * 10)
Next i
End Sub

燕归来 · 发表于 2012-7-12 14:32:00

初学vba，简单试试要把excel中的一个数据传到cad中作为圆心坐标，老是不行啊

雪山飞狐_lzh · 发表于 2012-7-12 14:44:00

你可以试下用Sql方式打开Excel表
网上类似的代码很多

longer1000 · 发表于 2012-7-13 08:39:00

太难了，学不会

markc0826 · 发表于 2012-7-19 18:07:00

copy


Sub cc100()
        Dim cc(0 To 2) As Double
        Dim dd(0 To 2) As Double
        On Error Resume Next
        Set ExcelApp = GetObject(, "Excel.Application")
        If Err  0 Then
        Set ExcelApp = CreateObject("Excel.Applicationn")
        End If
        Set ExcelApp = CreateObject("excel.application")
        
        ExcelApp.Workbooks.Open ("C:\123.xls")
        Set excelsheet = ExcelApp.ActiveWorkbook.Sheets("sheet1")
        cc(0) = 1000
        cc(1) = 1000
        cc(2) = 0
        dd(0) = excelsheet.range("a1").Value
        dd(1) = excelsheet.range("a1").Value
        dd(2) = 0
        
        For i = 1 To 100 Step 10
            Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
            Call ThisDrawing.ModelSpace.AddCircle(dd, i * 10)
        Next i
End Sub