- UID
- 658062
- 积分
- 2147
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2008-10-22
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
Imports System.IO
Imports Microsoft.Office.Interop.Excel
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
'Imports MyProjectName.MyProjectName
<Assembly: CommandClass(GetType(MyProjectName.MyClassName))>
Namespace MyProjectName
Public Class MyClassName
<CommandMethod("hex")> _
Public Sub ExcelToAcad()
ReadExcelRange("C:\Test\TestXL.xlsx", "Sheet1")'<-- change file name and sheet name here
End Sub
Public Sub ReadExcelRange(ByVal xlFileName As String, ByVal xlSheetName As String)
Dim lstPlines As New List(Of List(Of Object))
If System.IO.File.Exists(xlFileName) Then
Dim xlApp As Excel.Application = Nothing
Dim xlWorkBooks As Excel.Workbooks = Nothing
Dim xlWorkBook As Excel.Workbook = Nothing
Dim xlWorkSheet As Excel.Worksheet = Nothing
Dim xlWorkSheets As Excel.Sheets = Nothing
Dim xlCells As Excel.Range = Nothing
Dim xlRange As Excel.Range = Nothing
xlApp = New Excel.Application
Try
xlApp.DisplayAlerts = False
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Open(xlFileName)
xlApp.Visible = False
xlWorkSheets = xlWorkBook.Sheets
xlWorkSheet = CType(xlWorkSheets(xlSheetName), Excel.Worksheet)
xlRange = CType(xlWorkSheet.UsedRange.CurrentRegion, Excel.Range)
Dim xlRow As Excel.Range = Nothing
Dim xlCell As Excel.Range = Nothing
For irow As Integer = 1 To xlRange.Rows.Count
xlRow = CType(xlRange.Rows(irow), Excel.Range)
Dim lstRow As New List(Of Object)
For icol As Integer = 1 To xlRow.Cells.Count
xlCell = CType(xlRange.Cells(irow, icol), Excel.Range)
If xlCell.Value IsNot Nothing Then
lstRow.Add(xlCell.Value)
End If
Next
lstPlines.Add(lstRow)
Next
releaseObject(xlCell)
releaseObject(xlRow)
releaseObject(xlRange)
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlWorkSheets)
releaseObject(xlWorkSheet)
releaseObject(xlWorkBook)
releaseObject(xlWorkBooks)
releaseObject(xlApp)
Catch ex As System.Exception
System.Windows.MessageBox.Show(ex.Message)
End Try
If lstPlines.Count > 0 Then
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
For Each lstCoords As List(Of Object) In lstPlines
Dim pline As New Polyline
Dim n As Integer = 0
Dim i As Integer = 0
For n = 0 To lstCoords.Count - 1 Step 2
Dim x As Double = Convert.ToDouble(lstCoords(n))
Dim y As Double = Convert.ToDouble(lstCoords(n + 1))
Dim pp As Point2d = New Point2d(x, y)
pline.AddVertexAt(i, pp, 0, 0, 0)
i += 1
Next
btr.AppendEntity(pline)
tr.AddNewlyCreatedDBObject(pline, True)
Next
tr.Commit()
System.Windows.MessageBox.Show("See result.")
End Using
End If
Else
System.Windows.MessageBox.Show("'" & xlFileName & "' does not found.")
End If
End Sub
Public Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
obj = Nothing
Catch ex As System.Exception
System.Diagnostics.Debug.Print(ex.ToString())
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Namespace
|
|