When I was making some assembly drawings earlier this week. When I got to the Bill of Materials. I was thinking is there a way in VBA for it to make the Bill of Material for you ? You know tell it how make parts you have and it automatically put that amount rows in ? You know stuff like that.

tooldesigner,

Automated bill of materials have been used in CAD extensively. All the data extractions use loops to find out the information and place it into a tabular form.

There are many ways to insert then extract the information from the drawing and I list some of the ways below:-

Layers - set the drawing entities to a particular layer and when then loop to extract data.

Blocks - set the drawing entities into blocks then loop to count or extract data.

Block Attributes - place hidden attributes in blocks and loop to extract the data.

Extended Entity Data (EED) - add additional data to the drawing entities then loop to extract.

As you can see it really boils down to how you propose to create the data in the first place. I created a third party add-on program in ICAD VBA to place fire detection (smoke/heat/thermal detectors) blocks in a drawing and add the addresses to each entity. The addresses included the zone, location, type and other information that was later extracted into tables. It was a laborious task for the user to manually create the tables because it used to take about six hours to draw these manually.

The program created the tables in less than a minute allowing the user to increase his income while producing consistent accurate drawings. The blocks were extracted into a symbol legend and this ensured that the legend was drawing specific and none were missed.


------------------
Regards
John Finlay
Don't want to post a question - email me direct on john@acecad.com.au

John can you show us some expampled of how to do that in VBA please. I am interested in knowing how to do that. Thanks in advance.

All who are interested in speed!

Open a new drawing and setup the following layers:

Steel
StainlessSteel
Plastic
Tin
Brass
Text

Draw some lines in all the layers except Text and set the Text layer current.

open the VBA IDE and add a new module to to the new drawing.

copy and paste the code below into the module:-

Start Code -->>

Private TextScale As Double ' this is the scale used for dimensions x 2 and used for the text height
Private RowWidth As Double ' this is the width of the rows for our BOM table
Private RowHeight As Double ' this is the height of the rows for our BOM table
Private objSPnt As Point ' start point for table lines
Private objEPnt As Point ' endt point for table lines
Private objSSTemp As SelectionSet
Private objSTPnt As Point ' start point for Text
Private objHorizontalLine As Line ' this is the horizontal line of the table
Private objVerticalLine As Line ' this is the vertical line of the table
Private Item As Integer

Sub BOMExample()

Item = 0 'initial counter for the items

' obtain comprehensive drawing scale
TextScale = ThisDocument.GetVariable("DIMSCALE") * 2

' calculate the RowWidth
RowWidth = TextScale * 60#

' calculate the RowHeight
RowHeight = TextScale * 3#

' Obtain the top left starting point for the header
Set objSPnt = ThisDocument.Utility.GetPoint(, "Locate Top Left Starting Point")

' calculate end point
Set objEPnt = ThisDocument.Utility.PolarPoint(objSPnt, 0, RowWidth)

' draw the top line
Set objHorizontalLine = ThisDocument.ModelSpace.AddLine(objSPnt, objEPnt)
objHorizontalLine.Update


' draw the lines and text for the header
InsertLine "ITEM", "MATERIAL", "LENGTH", "TOTAL"

'obtain the lines in the layers
Set objSSTemp = objSS("Steel")
If objSSTemp.Count > 0 Then Materials "Steel"

'obtain the lines in the layers
Set objSSTemp = objSS("StainlessSteel")
If objSSTemp.Count > 0 Then Materials "StainlessSteel"

'obtain the lines in the layers
Set objSSTemp = objSS("Plastic")
If objSSTemp.Count > 0 Then Materials "Plastic"

'obtain the lines in the layers
Set objSSTemp = objSS("Tin")
If objSSTemp.Count > 0 Then Materials "Tin"

'obtain the lines in the layers
Set objSSTemp = objSS("Brass")
If objSSTemp.Count > 0 Then Materials "Brass"

End Sub

Private Sub Materials(myLayer As String)

Dim I As Integer
Dim objEnt As Line
Dim Length As Double
Dim Total As Double
Dim TotalLength As String

' loop through each line in the layer and insert lines and text
For I = 1 To objSSTemp.Count

' calc length
Set objEnt = objSSTemp(I)
Length = Library.CalculateDistance(objEnt.StartPoint, objEnt.EndPoint)
Total = Total + Length
' increment the item to the next number
Item = Item + 1

' only place the total length at the end of each material
If I = objSSTemp.Count Then
TotalLength = CStr(Round(Total, 2))
Else
TotalLength = ""
End If

' run the subroutine below to draw lines and locate text
InsertLine CStr(Item), myLayer, CStr(Round(Length, 2)), TotalLength

Next I

End Sub

Private Sub InsertLine(myItem As String, myMaterial As String, myLength As String, myTotal As String)
Dim TextPnt As Point
Dim objText As Text

' calculate new points for horizontal line
Set objSPnt = Library.CreatePoint(objSPnt.x, objSPnt.y - RowHeight, 0)
Set objEPnt = Library.CreatePoint(objSPnt.x + RowWidth, objSPnt.y, 0)
' draw the bottom line
Set objHorizontalLine = ThisDocument.ModelSpace.AddLine(objSPnt, objEPnt)
objHorizontalLine.Update

' draw vertical lines using sub DrawVLines
DrawVLines 0#
DrawVLines TextScale * 10#
DrawVLines TextScale * 30#
DrawVLines TextScale * 45#
DrawVLines TextScale * 60#

' calc point and place the text
Set TextPnt = Library.CreatePoint(objSPnt.x + (TextScale * 3), objSPnt.y + TextScale, 0)
Set objText = ThisDocument.ModelSpace.AddText(myItem, TextPnt, TextScale)
objText.Update

Set TextPnt = Library.CreatePoint(TextPnt.x + (TextScale * 10), TextPnt.y, 0)
Set objText = ThisDocument.ModelSpace.AddText(myMaterial, TextPnt, TextScale)
objText.Update

Set TextPnt = Library.CreatePoint(TextPnt.x + (TextScale * 20), TextPnt.y, 0)
Set objText = ThisDocument.ModelSpace.AddText(myLength, TextPnt, TextScale)
objText.Update

Set TextPnt = Library.CreatePoint(TextPnt.x + (TextScale * 15), TextPnt.y, 0)
Set objText = ThisDocument.ModelSpace.AddText(myTotal, TextPnt, TextScale)
objText.Update


End Sub


Private Sub DrawVLines(myOffset As Double)

Dim objVPnt As Point
Dim objVEPnt As Point
' calculate points and draw vertical lines
Set objVPnt = Library.CreatePoint(objSPnt.x + myOffset, objSPnt.y, 0)
Set objVEPnt = Library.CreatePoint(objSPnt.x + myOffset, objSPnt.y + RowHeight, 0)
Set objVerticalLine = ThisDocument.ModelSpace.AddLine(objVPnt, objVEPnt)
objVerticalLine.Update

End Sub

Private Function objSS(LayerName As String) As SelectionSet

Dim GPC(0) As Integer
Dim GPV(0) As Variant

'Create empty selection Set
Set objSS = IntelliCAD.ActiveDocument.SelectionSets.Add("SetName")

' set filters to speed up the search by looking at only lines on a defined layer
GPC(0) = 8 ' dxf code for layer
GPV(0) = LayerName ' layer name

' populate filtered selection set
objSS.Select vicSelectionSetAll, , , GPC, GPV

End Function

End Code --<<

Place your cursor in the Sub BOMExample

You will be asked to select the upper left corner and the table will display the following:-

Item Number
Material
Length
Total at the end of each material

Have fun

------------------
Regards
John Finlay
Don't want to post a question - email me direct on john@acecad.com.au

Thanks John I will try it as soon as I get to work. I am sure it will work great.