26 | 02 | 2017

Create Bill of Materials in AutoCad from Excel

The tutorial below shows how Excel can connect to AutoCad to create a Bill of Materials. 

Step 1: Download PARTS LIST 1.dwg and PARTS LIST BOTTOM.dwg from the source package below. These AutoCad files contain blocks that will be used in this tutorial. Download these files and save them on you C:\ drive.

Step 2: Create a new Excel file and create a five columns Bill of Materials. Like the screenshot below


 Bill of Material Sample data

Step 3: Open the Visual Basic editor (ALT +F11) in Excel

Step 4: Set the project reference to AutoCad Toolbar Extra > Reference

            (this tutorial is made using AutoCad 2011)


Set reference screen

Step 4. In the Visual Basic editor go to Sheet1 and add the following function to set the connection to AutoCad.

Public ThisDrawing As AcadDocument

Function Connect2AutoCad() As Boolean
'*** Code from VisibleVisual.com ********
Dim Acad As AcadApplication
On Error Resume Next
Connect2AutoCad = False

'Check if AutoCad is open
Set Acad = GetObject(, "AutoCAD.Application")
If Err Then
MsgBox "Autocad Application is Not Open"

Exit Function
'Attempt to open AutoCad
Set Acad = CreateObject("AutoCAD.Application")
'AutoCAD isn't available
If Err Then
MsgBox "Can't start AutoCAD!", vbExclamation, "Error loading AutoCAD"
End If
End If
Set ThisDrawing = Acad.ActiveDocument
Connect2AutoCad = True
Acad.Visible = True
End Function

Step 5: Add the code that will create the Bill of Material from the excel data.

Sub CreatePartsList()

'Make the connection with Autocad

If Connect2AutoCad = False Then MsgBox "Connection failed": Exit Sub

Dim objBlockRef As Object
Dim i As Integer
Dim rowi As Long

'Get the last row containing data in active excel sheet
rowi = Me.UsedRange.Row - 1 + Me.UsedRange.Rows.Count

'Set the Bill of Material (BOM) Insertion point (in this case 0,0,0)
Dim dblInsertPt(0 To 2) As Double 'Set the insert point of the parts list
dblInsertPt(0) = 0: dblInsertPt(1) = 0: dblInsertPt(2) = 0

'Create the parts list title row
'Make sure you set the path to the location of the block.
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(dblInsertPt, "C:\PARTS LIST BOTTOM.dwg", 1, 1, 1, 0)

'Add the rows to the BOM
For i = 1 To rowi - 1

    'reset the y coordinate to insert the next row (set to - to make a top to bottom list)
    dblInsertPt(1) = dblInsertPt(1) + (6)
    Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(dblInsertPt, "C:\PARTS List1.dwg", 1, 1, 1, 0)
    'Add the data to the block attributes
    SetText objBlockRef, "NUMBER", Me.Cells(i + 1, 1).Value
    SetText objBlockRef, "AMNT", Me.Cells(i + 1, 2).Value
    SetText objBlockRef, "TITLE", Me.Cells(i + 1, 3).Value
    SetText objBlockRef, "TYPE", Me.Cells(i + 1, 4).Value
    SetText objBlockRef, "ART", Me.Cells(i + 1, 5).Value

Next i

Exit Sub
MsgBox Err.Description & "-" & Err.Number
End Sub

Private Sub SetText(objBlockRef As Object, strTag As String, strValue)

On Error GoTo STERR:

Dim i As Integer
Dim objAttributes As Variant

objAttributes = objBlockRef.GetAttributes

For i = 0 To UBound(objAttributes)
'Debug.Print objAttributes(i).TagString
If objAttributes(i).TagString = strTag Then
objAttributes(i).TextString = strValue
Exit For
End If
Next i

Exit Sub
'Err.Raise Err
Exit Sub
End Sub

Step 6. Test the code by running the CreatePartsList macro. The result should look like this:

 Result of running the CreatePartsList macro.

Enjoy this code. Download the tutorial files below (registered users only).



Sign up now and upload your code to the website.

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