topic Re: Do-until loop to create 3D model assemblies and Drawings for each assembly in Inventor Programming Forum

Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Thu, 22 Sep 2022 10:36:18 GMT

Hi everyone,

I am creating a do-until loop to create assemblies from parts. The 3D assemblies are working fine.
However, when I create the 2D drawing for each assembly using a reference drawing, the new 3D model is not linked and replaces the reference one.
Please see the attached screenshot showing when I am trying to save the 2D drawing.
I appreciate any help and thank you for your support.

Best regards

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Thu, 22 Sep 2022 14:38:57 GMT

So what is missing here is the replace reference in the drawing. So as you need to do in a drawing manually you have to do by code also. The post here has a handy function to do that.

Function DrawingReplace(OldLoc As String, newname As String)
Dim OldName As String = Left(OldLoc, Len(OldLoc) -3) & "dwg"
Dim DrawDoc As DrawingDocument = ThisApplication.Documents.Open(OldName, False)

Dim DrawingName As String = (Left(newname, Len(newname) -3) & "dwg")

If Dir((Left(newname, Len(newname) -3) & "dwg")) = "" Then
DrawDoc.SaveAs(DrawingName, False)
End If

Dim oFD As FileDescriptor
 oFD = DrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor
  oFD.ReplaceReference(newname)

 DrawDoc.Update()
 DrawDoc.Save
 DrawDoc.Close

End Function

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Thu, 22 Sep 2022 15:47:05 GMT

Thank you, Alan, for your message. It was helpful.

However, I am still getting some errors while running the code. Please note that I am running this code from an empty assembly. And it creates assemblies based on the input from the excel sheet.

I have a reference drawing for all of the assemblies. I want the code to create a new drawing for each of the assemblies and save it in a different folder.

Please let me know if you want me to share the code or if that is sufficient to get an answer.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Fri, 23 Sep 2022 00:07:20 GMT

If you can share all the code that is doing the work other wise anyone trying to help is just guessing as to how it is constructed. There will likely be a workflow issue when changing from document to document so ensure you activate the correct document and pass through the fullfilename as necessary.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Fri, 23 Sep 2022 07:53:46 GMT

Hi Alan,

Thanks again for your constant support.

Please see below my code. It generates 3D model configurations from the excel sheet and saves the part numbers also from it.

The problem is when I want to generate a detailed drawing for each assembly based on the reference drawing that I already have. The code saves the drawings and part numbers based on the excel sheet, but it is not replacing the reference model with the current one.

Dim path As String
Dim i As Integer = 1
Dim a As Integer

path = "J:\Employees\Elie Almurr\Ilogic\"
NolzPath = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT\"

j = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet1", "I2")

Do Until i = j + 1
	

Dim oList = GoExcel.CellValues(path + "standardSizes_02.xlsx", "Sheet3", "A" & i+1, "D" & i+1)


Dim FlangeFolder As String

Dim oNewAssy As AssemblyDocument
oNewAssy = ThisApplication.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject)
	


	oNozSize = oList(0)
	'MessageBox.Show(oNozSize, "SIZE")
	'oNozSch = Split(name, "-")(1)
	'MessageBox.Show(oNozSch, "SCH")
	oNozLen = oList(1)
	'MessageBox.Show(oNozLen, "LEN")
	oFlgType = oList(2)
	'MessageBox.Show(oFlgType, "TYPE")
	oFlgRtng = oList(3)
	'MessageBox.Show(oFlgRtng, "RATING")

	
	
	Dim oMatrix As Matrix
	oMatrix = ThisApplication.TransientGeometry.CreateMatrix() 
	

	'\\\ here are the paths where the flanges and pipe are saved at. 
	RP_FlangePath = "J:\Employees\Elie Almurr\Ilogic\RP_Flange\" & oNozSize & "-" & oNozLen & "-" & "RP" & ".ipt"
	ST_FlangePath = "J:\Employees\Elie Almurr\Ilogic\ST_Flange\" & oNozSize & "-" & "10" & "-" & "RF" & ".ipt"

	Dim componentA As ComponentOccurrence 
	componentA = oNewAssy.ComponentDefinition.Occurrences.Add(RP_FlangePath, oMatrix)
	componentA.Name = "Pipe"

	Dim componentB As ComponentOccurrence 
	componentB = oNewAssy.ComponentDefinition.Occurrences.Add(ST_FlangePath, oMatrix)
	componentB.Name = "Flange" 
	
	
	
	Dim wPlaneA As WorkPlane
	wPlaneA = componentA.Definition.Workplanes.Item("Work Plane1")
	Dim wPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(wPlaneA,wPlaneA_proxy)

	Dim wPlaneB As WorkPlane
	wPlaneB = componentB.Definition.Workplanes.Item("Work Plane2")
	Dim wPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(wPlaneB, wPlaneB_proxy)
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(wPlaneA_proxy, wPlaneB_proxy, "5/25.4")
	
	
	Dim xzPlaneA As WorkPlane
	xzPlaneA = componentA.Definition.Workplanes.Item("XZ Plane")
	Dim xzPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(xzPlaneA,xzPlaneA_proxy)

	Dim xzPlaneB As WorkPlane
	xzPlaneB = componentB.Definition.Workplanes.Item("XZ Plane")
	Dim xzPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(xzPlaneB, xzPlaneB_proxy)
	
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(xzPlaneA_proxy, xzPlaneB_proxy, "0")
	
	
	Dim yzPlaneA As WorkPlane
	yzPlaneA = componentA.Definition.Workplanes.Item("YZ Plane")
	Dim yzPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(yzPlaneA,yzPlaneA_proxy)

	Dim yzPlaneB As WorkPlane
	yzPlaneB = componentB.Definition.Workplanes.Item("YZ Plane")
	Dim yzPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(yzPlaneB, yzPlaneB_proxy)
	
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(yzPlaneA_proxy, yzPlaneB_proxy, "0")
	
	Dim PN As String
	Dim oCustomProp As Inventor.Property 
	Try
		oNewAssy.PropertySets.Item(4).Item("Custom Prop").Value = "Custom Value"
	Catch
		oCustomProp = oNewAssy.PropertySets.Item(4).Add("Custom value", "Custom Prop")
	End Try 
	oNewAssy.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "F" & i+1)

	oNewAssy.PropertySets.Item("Design Tracking Properties").Item("Description").Value = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "G" & i+1)

	Try
	name = (name).Replace("/", "_")
	Catch
	End Try
	
	PN = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "F" & i+1)

	Call oNewAssy.SaveAs(NolzPath + PN + ".iam", False)
	
	Call oNewAssy.Close
	
	
	Dim dPN As String
	Dim dDES As String

	dPN = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "H" & i + 1)
	dDES = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "I" & i + 1)
	
	Dim NewDwg As String = "j:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT DWN\" & dPN & ".idw"
	Dim RefDwg As String = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT DWN\ASSEMBLY_REF.idw"
	
	Dim oDrawDoc As DrawingDocument
	

	
	oDrawDoc = ThisApplication.Documents.Open(RefDwg, False)
	oDrawDoc.SaveAs(NewDwg, False)
	
	iProperties.Value("Project", "Part Number") = dPN
	iProperties.Value("Project", "Description") = dDES
	iProperties.Value("Summary", "Title") = dDES
	
	oDrawDoc.Update()
	oDrawDoc.Save
	oDrawDoc.Close
	

i = i + 1

Loop



MessageBox.Show("Done", "Title")

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Fri, 23 Sep 2022 17:19:34 GMT

I have put together a quick sample to save a new assembly and open an existing drawing and swap the reference file and save as new name. Insert the replace reference lines inside your code and likely that is all you need.

	sFileName = InputBox("Prompt", "Title", "Default Entry")

	Dim oNewAssy As AssemblyDocument = ThisDoc.Document

	Dim NewAssyFullFileName As String = "C:\Users\aacheson\Desktop\WFH\Samples\assembly\" + sFileName + ".iam"

	Call oNewAssy.SaveAs(NewAssyFullFileName, False)
	
	Dim NewDwg As String = "C:\Users\aacheson\Desktop\WFH\Samples\assembly\" + sFileName + ".idw"
	Dim RefDwg As String = "C:\Users\aacheson\Desktop\WFH\Samples\assembly\" + "Test Assembly.idw"
	
	Dim DrawDoc As DrawingDocument = ThisApplication.Documents.Open(RefDwg, False)
	
	'Replace the reference file in the drawing
	Dim oFD As FileDescriptor = DrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor
	oFD.ReplaceReference(NewAssyFullFileName)

	DrawDoc.Update()
	DrawDoc.SaveAs(NewDwg, True)
	DrawDoc.Close
	MessageBox.Show("Done", "Title")

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Fri, 23 Sep 2022 23:47:31 GMT

Hi Alan,

Thank you for your message, it was really helpful and solved most of the problems.

However, I still have a few issues if you don't mind helping with them.

When I added this code, it looks like the new drawing is added to the reference one instead of replacing it and the bill of material is not updated (it is still linked to the reference model).

Also is it possible to save the new drawings with a different number than the ipt?

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Sat, 24 Sep 2022 00:22:53 GMT

Can you share the code on how you have integrated the replace reference code?

Using the below code and supplying the fullfilepath of the assembly you can swap the reference of the drawing.

Dim DrawDoc As DrawingDocument = ThisApplication.Documents.Open(RefDwg, False)
	
	'Replace the reference file in the drawing
	Dim oFD As FileDescriptor = DrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor
	oFD.ReplaceReference(NewAssyFullFileName)

If the drawing has a model reference of a part .ipt you can not swap it for an assembly .iam. You must replace like for like document types.

You mentioned Bill of materials do you mean the partlist? Maybe a few images of the troubled areas your seeing.

To trouble shoot you may want to set up document name checks using message box and logger.info for debugging.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Sat, 24 Sep 2022 07:52:30 GMT

Hi Alan, Please see below the code and how I integrated the replacement reference code. I am replacing the asm.iam with a similar asm.iam.

I am also sharing a screenshot of the drawing and the partlist.

Thanks again for your time.

Dim path As String
Dim i As Integer = 1
Dim a As Integer

path = "J:\Employees\Elie Almurr\Ilogic\"
NolzPath = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT\"

j = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet1", "I2")

Do Until i = j + 1
	

Dim oList = GoExcel.CellValues(path + "standardSizes_02.xlsx", "Sheet3", "A" & i+1, "D" & i+1)


Dim FlangeFolder As String

Dim oNewAssy As AssemblyDocument
oNewAssy = ThisApplication.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject)
	


	oNozSize = oList(0)
	'MessageBox.Show(oNozSize, "SIZE")
	'oNozSch = Split(name, "-")(1)
	'MessageBox.Show(oNozSch, "SCH")
	oNozLen = oList(1)
	'MessageBox.Show(oNozLen, "LEN")
	oFlgType = oList(2)
	'MessageBox.Show(oFlgType, "TYPE")
	oFlgRtng = oList(3)
	'MessageBox.Show(oFlgRtng, "RATING")

	
	
	Dim oMatrix As Matrix
	oMatrix = ThisApplication.TransientGeometry.CreateMatrix() 
	

	'\\\ here are the paths where the flanges and pipe are saved at. 
	RP_FlangePath = "J:\Employees\Elie Almurr\Ilogic\RP_Flange\" & oNozSize & "-" & oNozLen & "-" & "RP" & ".ipt"
	ST_FlangePath = "J:\Employees\Elie Almurr\Ilogic\ST_Flange\" & oNozSize & "-" & "10" & "-" & "RF" & ".ipt"

	Dim componentA As ComponentOccurrence 
	componentA = oNewAssy.ComponentDefinition.Occurrences.Add(RP_FlangePath, oMatrix)
	componentA.Name = "Pipe"

	Dim componentB As ComponentOccurrence 
	componentB = oNewAssy.ComponentDefinition.Occurrences.Add(ST_FlangePath, oMatrix)
	componentB.Name = "Flange" 
	
	
	
	Dim wPlaneA As WorkPlane
	wPlaneA = componentA.Definition.Workplanes.Item("Work Plane1")
	Dim wPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(wPlaneA,wPlaneA_proxy)

	Dim wPlaneB As WorkPlane
	wPlaneB = componentB.Definition.Workplanes.Item("Work Plane2")
	Dim wPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(wPlaneB, wPlaneB_proxy)
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(wPlaneA_proxy, wPlaneB_proxy, "5/25.4")
	
	
	Dim xzPlaneA As WorkPlane
	xzPlaneA = componentA.Definition.Workplanes.Item("XZ Plane")
	Dim xzPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(xzPlaneA,xzPlaneA_proxy)

	Dim xzPlaneB As WorkPlane
	xzPlaneB = componentB.Definition.Workplanes.Item("XZ Plane")
	Dim xzPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(xzPlaneB, xzPlaneB_proxy)
	
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(xzPlaneA_proxy, xzPlaneB_proxy, "0")
	
	
	Dim yzPlaneA As WorkPlane
	yzPlaneA = componentA.Definition.Workplanes.Item("YZ Plane")
	Dim yzPlaneA_proxy As WorkPlaneProxy
	componentA.CreateGeometryProxy(yzPlaneA,yzPlaneA_proxy)

	Dim yzPlaneB As WorkPlane
	yzPlaneB = componentB.Definition.Workplanes.Item("YZ Plane")
	Dim yzPlaneB_proxy As WorkPlaneProxy
	componentB.CreateGeometryProxy(yzPlaneB, yzPlaneB_proxy)
	
	
	Call oNewAssy.ComponentDefinition.Constraints.AddMateConstraint(yzPlaneA_proxy, yzPlaneB_proxy, "0")
	
	Dim PN As String
	Dim oCustomProp As Inventor.Property 
	Try
		oNewAssy.PropertySets.Item(4).Item("Custom Prop").Value = "Custom Value"
	Catch
		oCustomProp = oNewAssy.PropertySets.Item(4).Add("Custom value", "Custom Prop")
	End Try 
	oNewAssy.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "F" & i+1)

	oNewAssy.PropertySets.Item("Design Tracking Properties").Item("Description").Value = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "G" & i+1)

	Try
	name = (name).Replace("/", "_")
	Catch
	End Try
	
	PN = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "F" & i+1)

	Call oNewAssy.SaveAs(NolzPath + PN + ".iam", False)
	
	Call oNewAssy.Close
	
	
	
'	sFileName = InputBox("Prompt", "Title", "Default Entry")
	sFileName = GoExcel.CellValue(path + "standardSizes_02.xlsx", "Sheet3", "F" & i+1)

'	Dim oNewAssy As AssemblyDocument = ThisDoc.Document

	Dim NewAssyFullFileName As String = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT\" + sFileName + ".iam"

'	Call oNewAssy.SaveAs(NewAssyFullFileName, False)
	
	Dim NewDwg As String = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT DWN\" + sFileName + ".idw"
	Dim RefDwg As String = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT DWN\" + "ASSEMBLY_REF.idw"
	
	Dim DrawDoc As DrawingDocument = ThisApplication.Documents.Open(RefDwg, False)
	
	'Replace the reference file in the drawing
	Dim oFD As FileDescriptor = DrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor
	oFD.ReplaceReference(NewAssyFullFileName)

	DrawDoc.Update()
	DrawDoc.SaveAs(NewDwg, True)
	DrawDoc.Close
	

i = i + 1

Loop



MessageBox.Show("Done", "Title")

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Sun, 25 Sep 2022 18:57:20 GMT

It is a little hard to test but maybe you can check if you are supplying the right file paths.

I see the assembly is saved as this path

Call oNewAssy.SaveAs(NolzPath + PN + ".iam", False)

and then the drawing is being replaced by this assembly reference path

Dim NewAssyFullFileName As String = "J:\Employees\Elie Almurr\Ilogic\FLANGE_WELDMENT\" + sFileName + ".iam"

Are these the same paths?

In the image you supplied is there only one referenced model on the drawing sheet?

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Sun, 25 Sep 2022 20:03:26 GMT

Hi Alan, yeah both have the same path to the assembly model.

In the reference drawing, I only have one referenced model. I find it so weird why it is doing that when I try and replace this model with a new one.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Mon, 26 Sep 2022 07:22:45 GMT

Hi Alan, after re-running the code, everything seems to work fine now except for the part list. It is not updating by itself.

Can you please recommend if we must add a specific code to update it?

Thank you for all the support.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Mon, 26 Sep 2022 07:46:39 GMT

That is unusual. Is it still remaining linked to the old assembly? If you toggle the partslist style manually does it update? If you supply a new drawing does it still not change the partslist?

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Mon, 26 Sep 2022 07:48:42 GMT

If you update it manually, it does update; you have to open it one by one and update the part list.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Mon, 26 Sep 2022 14:29:35 GMT

When you say update partslist manually, what operation are you performing? The partslist doesn't have an update method.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

elie.t.almurr — Mon, 26 Sep 2022 15:29:15 GMT

It updates itself when I open the drawing and right-click and edit the part list.

Re: Do-until loop to create 3D model assemblies and Drawings for each assembly

A.Acheson — Wed, 28 Sep 2022 20:18:44 GMT

The not updating the drawing is little strange. If you close and reopen the drawing does it update upon opening? If you have to edit the parts list to show the refreshed data you can also edit the parts list by code.

If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Can only run rule on drawing documents.")
		Exit Sub
	End If
	Dim oDrawDoc As DrawingDocument
	oDrawDoc = ThisApplication.ActiveDocument
	cd = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingPartsListEditCtxCmd")
	Dim oSheet As Sheet
	Dim oSheetNo As Integer
	For Each oSheet In oDrawDoc.Sheets
		For Each oPL As PartsList In oSheet.PartsLists
			If oSheet.PartsLists.Count = 1 Then 
				oSheet.Activate
				oDrawDoc.SelectSet.Clear
				oDrawDoc.SelectSet.Select(oPL)
				cd.Execute
				Return
			End If
		Next
	Next