找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1092|回复: 0

[分享] Draw Polylines using Excel

[复制链接]

已领礼包: 859个

财富等级: 财运亨通

发表于 2014-6-7 03:28:07 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-22 16:51 , Processed in 0.372655 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表