22 | 06 | 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
Next
 
End Sub

Download project below (registered users only)

 

 

Login

Sign up now and upload your code to the website.

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