Create Drawing & Add Parts List

[ablountE9KSN]

So I'm working on a macro that will create a drawing, add a revision table, and in this case add the base view and parts list. 

I've run this macro a few times without error - but this time it is erroring out on adding the parts list. I attempted to debug a bit and this is the information I gathered.

• When I paused the macro right before the "Set BOM = ..." and manually added in a parts list - the macro ran fine and added in an additional parts list

Here is my code

Sub CreateDrawing()

Dim InvApp As Inventor.Application
Dim InvDoc As Inventor.Document
Dim InvDwg As Inventor.DrawingDocument

Set InvApp = Inventor.ThisApplication
Set InvDoc = InvApp.ActiveDocument

'Get the name of the open document for later use
Dim Doc As String
Dim FileLocation As String
Dim FileExt As String

Doc = InvDoc.FullDocumentName
'Debug.Print Doc
FileExt = Right(Doc, 3)
'Debug.Print FileExt
FileLocation = Left(Doc, InStrRev(Doc, "\"))
'Debug.Print FileLocation
Doc = Mid(Doc, InStrRev(Doc, "\") + 1)
'Debug.Print Doc
Doc = Left(Doc, Len(Doc) - 4)
'Debug.Print Doc

'Create the drawing name
Dim dwgName As String
Dim FulldwgName As String
dwgName = Doc & ".idw"
FulldwgName = FileLocation & dwgName
'Debug.Print FulldwgName

'Check if the drawing exstis already
'If Dir(FulldwgName) <> "" Then
' MsgBox ("The drawing for this file already exists")
'Exit Sub
'End If


'Create new drawing
Dim TemplatePath As String
TemplatePath = "C:\Users\Public\Documents\Autodesk\Inventor 2024\Templates\en-US\CASStandard.idw"
Set InvDwg = InvApp.Documents.Add(kDrawingDocumentObject, TemplatePath, True)

'Initialize everythig on the sheet
Dim dwgSheet As Sheet
Dim dwgRevTable As RevisionTable
Dim dwgBaseView As DrawingView
Dim cornerpoint As Point2d

Set dwgSheet = InvDwg.ActiveSheet
Dim RevTableWidth As Double
RevTableWidth = InvDwg.UnitsOfMeasure.ConvertUnits(150, "mm", "cm")
'Debug.Print RevTableWidth

Set cornerpoint = ThisApplication.TransientGeometry.CreatePoint2d(dwgSheet.Border.RangeBox.MaxPoint.X - RevTableWidth, dwgSheet.Border.RangeBox.MaxPoint.Y)

'Add the revision table
Set dwgRevTable = dwgSheet.RevisionTables.Add2(cornerpoint, False, True, True)

'Initialize drawing variables
Dim BasePoint As Point2d
Set BasePoint = ThisApplication.TransientGeometry.CreatePoint2d((17 / 2) * 2.54 + 2.5, (11 / 2) * 2.54)
Dim BaseView As DrawingView
Dim BOM As PartsList
Dim BOMLoc As Point2d
Dim BOMWidth As Double
BOMWidth = InvDwg.UnitsOfMeasure.ConvertUnits(190, "mm", "cm")


Set BOMLoc = ThisApplication.TransientGeometry.CreatePoint2d(dwgSheet.Border.RangeBox.MinPoint.X + BOMWidth, dwgSheet.Border.RangeBox.MaxPoint.Y)
'Set BOMLoc = ThisApplication.TransientGeometry.CreatePoint2d(dwgSheet.Border.RangeBox.MinPoint.X + 10, dwgSheet.Border.RangeBox.MaxPointY)

'Guess at the drawing scale
Dim BoundBox As Box
Set BoundBox = InvDoc.ComponentDefinition.RangeBox

Dim dwgScale As Double

If BoundBox.MaxPoint.X > BoundBox.MaxPoint.Y And BoundBox.MaxPoint.X > BoundBox.MaxPoint.Z Then
dwgScale = Int((30 / (BoundBox.MaxPoint.X * 2)) / 0.25) * 0.25
BoundBoxMax = BoundBox.MaxPoint.X
BoundBoxMin = BoundBox.MinPoint.X

ElseIf BoundBox.MaxPoint.Y > BoundBox.MaxPoint.X And BoundBox.MaxPoint.Y > BoundBox.MaxPoint.Z Then
dwgScale = Int((30 / (BoundBox.MaxPoint.Y * 2)) / 0.25) * 0.25
BoundBoxMax = BoundBox.MaxPoint.Y
BoundBoxMin = BoundBox.MinPoint.Y

Else
dwgScale = Int((30 / (BoundBox.MaxPoint.Z * 2)) / 0.25) * 0.25
BoundBoxMax = BoundBox.MaxPoint.Z
BoundBoxMin = BoundBox.MinPoint.Z

End If

If dwgScale > 1 Then
dwgScale = Int(dwgScale / 2 / 0.25) * 0.25
End If

Debug.Print dwgScale

If dwgScale / 0.25 / 2 <> Round(dwgScale / 0.25 / 2, 0) Then
dwgScaleRatio = dwgScale * 4 & " / 4"

ElseIf dwgScale / 0.5 / 2 <> Round(dwgScale / 0.5 / 2, 0) Then
dwgScaleRatio = dwgScale * 2 & " / 2"

ElseIf dwgScale = 0 Then
dwgScale = 0.25
dwgScaleRatio = "1 / 4"

Else
dwgScaleRatio = dwgScale & " / 1"

End If

'Add base view to the drawing

If FileExt = "iam" Then
'If its an assembly add a parts list, and base view
Set BaseView = dwgSheet.DrawingViews.AddBaseView(InvDoc, BasePoint, dwgScale, kCurrentViewOrientation, kShadedDrawingViewStyle)
BaseView.ScaleString = dwgScaleRatio
On Error Resume Next
Set BOM = dwgSheet.PartsLists.Add(BaseView, BOMLoc, kStructured)
BOM.Sort "DISTRIBUTOR", True, "PART NUMBER", True
BOM.Renumber
On Error GoTo 0


Else
'Add first view
Set BaseView = dwgSheet.DrawingViews.AddBaseView(InvDoc, BasePoint, dwgScale, kCurrentViewOrientation, kHiddenLineDrawingViewStyle)

'Add projected up view
Dim UpView As DrawingView
Dim UpViewPos As Point2d

Set UpViewPos = ThisApplication.TransientGeometry.CreatePoint2d(BasePoint.X, dwgSheet.Border.RangeBox.MaxPoint.Y - 4)

Set UpView = dwgSheet.DrawingViews.AddProjectedView(BaseView, UpViewPos, kFromBaseDrawingViewStyle)

'Add projected left view
Dim LeftView As DrawingView
Dim LeftViewPos As Point2d

Set LeftViewPos = ThisApplication.TransientGeometry.CreatePoint2d(3, BasePoint.Y)

Set LeftView = dwgSheet.DrawingViews.AddProjectedView(BaseView, LeftViewPos, kFromBaseDrawingViewStyle)

BaseView.ScaleString = dwgScaleRatio

End If

End Sub

[AndrewHumiston · Accepted solution]

morning,

under your adding of a parts list, you may run into the bom not being enabled for the assembly you are placing the parts list for. i run into an error occasionally and i have to manually add the parts list, i have figured out that if you set the level as parts list in this manner i get far few errors, it seems to do with how the legacy BOM is carried from older files, we do a lot of design copying and run into this on occasion.

.add(baseview, location, partslistlevelenum.kstructuredalllevels)

[bradeneuropeArthur]

Something like this?

https://www.linkedin.com/posts/arthur-knoors_autodesk-kit-activity-7040083123883139072-5hfn?utm_sour...

[ablountE9KSN]

this seemed to work for me - thanks 

[AndrewHumiston]

i have code that creates the view then adds the parts list, but occasionally it does not work and its due to an outdated or legacy BOM issue.