22 | 02 | 2017

Export Blocks to Excel

The sub below shows the code that will export all AutoCad blocks including properties to Excel.

Sub CreateBlockListInExcel()

'Downloaded from VisibleVisual.com
'Free to use
'To use this macro in AutoCad make sure that the reference is set to Microsoft Excel XX Object Library
Dim blk As AcadBlockReference
Dim wrkb As Excel.Workbooks
Dim wrks As Excel.Worksheet
On Error Resume Next
'Check if Excel is open and if not open it.
Set objExcel = GetObject(, "Excel.Application")
If Err.Number > 0 Then
Set objExcel = CreateObject("Excel.Application")
End If
'Make sure excel is visible anddsv add a new workbook
objExcel.Visible = True
Set wrkb = objExcel.Workbooks.Add
Set wrks = objExcel.ActiveSheet
Dim rownr As Double
rownr = 1
'Loop through modespace
For Each blk In ThisDrawing.ModelSpace
rownr = rownr + 1
'Code below adds column names
wrks.Range("A1") = "BLOCKNAME"
wrks.Range("B1") = "LAYERNAME"
wrks.Range("C1") = "EFFECTIVENAME"
wrks.Range("D1") = "X"
wrks.Range("E1") = "Y"
wrks.Range("F1") = "Z"
'wrks.Range("G1") = "NEW COLUMN NAME"
'Fill the columns with block data from modelspace
wrks.Range("A" & rownr) = blk.Name
wrks.Range("B" & rownr) = blk.Layer
wrks.Range("C" & rownr) = blk.EffectiveName
wrks.Range("D" & rownr) = blk.InsertionPoint(0)
wrks.Range("E" & rownr) = blk.InsertionPoint(1)
wrks.Range("F" & rownr) = blk.InsertionPoint(2)
'wrks.Range("G" & rownr) = blk.  .....Extend/change the column to any value you like
End Sub

Download project below (registered users only)




Sign up now and upload your code to the website.

Help us to continue.....
Articles View Hits
Latest Articles