Solved: Make Assembly from Multi Body Part with custom naming!

mecanicu · ‎09-26-2023

Hi!
I can't figure out how to solve this problem with iLogic.
I have a multi body part and I want to make an assembly using make components. Name of the new parts in the assembly should consist of, Description from iProperties and name of the bodies.
New assembly name must be the same as the original part.

Thank you!

gerrardhickson · ‎09-26-2023

Hi Mecanicu,

Do you want help writing the code, or do you just want someone to do it for you?

Here's a very simple framework that might help:

Dim oMultiPart As PartDocument = ThisApplication.ActiveDocument
Dim oMCD As ComponentDefinition = oMultiPart.ComponentDefinition
Dim oBody As SurfaceBody
Dim sBodyNames As String

'Create new Assembly

For Each oBody In oMCD.SurfaceBodies
	sBodyNames = sBodyNames & vbCrLf & oBody.Name
	'Create new  Part file
	
	'Derive Part with reference to oBody
	
	'Add the body to the assembly - ground and root component
	
Next oBody

MessageBox.Show (sBodyNames)

The code itself only builds a list of the surface bodies, and shows you the list at the end - nothing else. But the purpose of the code is to show you how you might want to break the problem up into small steps. Each of the small steps isn't complex, so give it a try and report back with your progress.

mecanicu · ‎09-27-2023

Yesterday i have a non working version of the code. Now after some brain storming i manage to get it to work. But i still have some problem's. the main one is the part naming, now it's using the solid body's name. Here is the version i have:

 
' Run this inside a Multi-Solid part
Sub Main()
  ' Folder to place the new components:
  ' assembly and subcomponents
  Dim f As String 
   f = "C:\temp\test1\"
  Dim oTemplatesPath As String 
   oTemplatesPath = "C:\Users\Public\Documents\Autodesk\Inventor 2023\Templates\en-US"
  ' Make sure the folder exists
  Dim fso As Object
   fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(f) Then Call fso.CreateFolder(f)
  
  Dim doc As PartDocument
   doc = ThisApplication.ActiveDocument
  
  ' Create the assembly
  Dim asm As AssemblyDocument
   asm = ThisApplication.Documents.Add(kAssemblyDocumentObject, oTemplatesPath & "\SheetMetalDXF.iam", True)
  
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
    ' See if the body is visible
	If sb.Visible Then
    ' Create part for each body
    Dim prt As PartDocument
     prt = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Sheet Metal.ipt", True)
    
    ' Set iProperties >> Project >> Description
    ' It's inside "Design Tracking Properties"
    Dim p As String
     p = "lol" 'prt.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")("Description") !!!!!
     p = sb.Name

	Dim dpcs As DerivedPartComponents
     dpcs = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents
    
    Dim dpd As DerivedPartUniformScaleDef
     dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)
       
    ' Exclude the other solid bodies
    Dim dpe As DerivedPartEntity
    For Each dpe In dpd.Solids
      If Not dpe.ReferencedEntity Is sb Then
        dpe.IncludeEntity = False
      End If
    Next
    
     dpcs.Add(dpd)
    
    ' Could have any name but we use the solid body's name
	' !!!!!The final name needs to be part description + solid body's name!!!!!
     prt.SaveAs(f + sb.Name + ".ipt", False)
        
    ' Place an instance of it inside the assembly
    Dim mx As Matrix
     mx = ThisApplication.TransientGeometry.CreateMatrix()
     asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
    
    ' Don't need it anymore
     prt.Close
    End If
  Next
  
   asm.SaveAs(f + Left(doc.DisplayName, Len(doc.DisplayName) - 4) + ".iam", False)
   asm.Close
End Sub

gerrardhickson · ‎09-27-2023

Well you were very close to a solution.

Here's a working solution.

You'll need to change all the file\folder paths to suit your setup.

I'm sure y

' Run this inside a Multi-Solid part
Sub Main()
  ' Folder to place the new components:
  ' assembly and subcomponents
  Dim f As String 
   f = "F:\Vault\Design Files\_Temp\5. SaveMultiBodyAsAssembly\"
  Dim oTemplatesPath As String 
   oTemplatesPath = "F:\Vault\Design Files\_Admin\Templates"
  ' Make sure the folder exists
  Dim fso As Object
   fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(f) Then Call fso.CreateFolder(f)
  
  Dim doc As PartDocument
   doc = ThisApplication.ActiveDocument
  
  ' Create the assembly
  Dim asm As AssemblyDocument
   asm = ThisApplication.Documents.Add(kAssemblyDocumentObject, oTemplatesPath & "\Assembly.iam", True)
  
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
    ' See if the body is visible
	If sb.Visible Then
    ' Create part for each body
    Dim prt As PartDocument
     prt = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Standard Part.ipt", True)
    
    ' Set iProperties >> Project >> Description
    ' It's inside "Design Tracking Properties"
    Dim p As String
	'MessageBox.Show(doc.PropertySets("Design Tracking Properties")("Description").Value)
     p = doc.PropertySets("Design Tracking Properties")("Description").value
     p = p & " - " & sb.Name

	Dim dpcs As DerivedPartComponents
     dpcs = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents
    
    Dim dpd As DerivedPartUniformScaleDef
	'messagebox.Show(doc.FullDocumentName)
     dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)
       
    ' Exclude the other solid bodies
    Dim dpe As DerivedPartEntity
    For Each dpe In dpd.Solids
      If Not dpe.ReferencedEntity Is sb Then
        dpe.IncludeEntity = False
      End If
    Next
    
     dpcs.Add(dpd)
    
    ' Could have any name but we use the solid body's name
	' !!!!!The final name needs to be part description + solid body's name!!!!!
     prt.SaveAs(f + " - " +  p + ".ipt", False)
        
    ' Place an instance of it inside the assembly
    Dim mx As Matrix
     mx = ThisApplication.TransientGeometry.CreateMatrix()
     asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
    
    ' Don't need it anymore
     prt.Close
    End If
  Next
  
   asm.SaveAs(f + doc.displayname.replace(".ipt",".iam"), False)
   asm.Close
End Sub

mecanicu · ‎10-01-2023

Thank you @gerrardhickson!

I modify the first version for Multi Body Sheet Metal Part, it's not perfect, i have some problem with parsing Sheet Metal Style to new part's. And i wish to make it External Rule, for now it's only working from part level. + i include a DXF export function also.

 
' Run this inside a Multi-Solid part; Custom for Multi-Solid Sheet Metal Part
Sub Main()
  ' Determine master part type '''' here is a test code to store the active sheet metal style and past it to new part's '''
  Dim doc As PartDocument = ThisApplication.ActiveDocument
      If doc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
      Dim oDocSheetMetalCompDef As SheetMetalComponentDefinition = doc.ComponentDefinition
      Dim oDocSheetMetalStyle As SheetMetalStyle = oDocSheetMetalCompDef.ActiveSheetMetalStyle
	  oDocSheetMetalStyle.SaveToGlobal
	  End If
  ' Same Folder as Master Part to place the new components:
  ' assembly and subcomponents
  Dim f As String 
      f = ThisDoc.Path & "\" 
  ' Templates Folder
  Dim oTemplatesPath As String 
      oTemplatesPath = "C:\Users\Public\Documents\Autodesk\Inventor 2023\Templates\en-US"
  ' Make Folder for DFX export !!! folder name is master part name & DXF File
  Dim oFolder As String = f & doc.DisplayName.Replace(".ipt", " DXF File")
  Dim fso As Object
      fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(oFolder) Then fso.CreateFolder(oFolder)
  ' Create the assembly, select assembly template 
  Dim asm As AssemblyDocument
      asm = ThisApplication.Documents.Add(kAssemblyDocumentObject, oTemplatesPath & "\SheetMetalDXF.iam", True)
  ' Iterate through solid bodies
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
  ' See if the solid body is visible
      If sb.Visible Then
  ' Create new part for each solid body, , select part template
	  Dim prt As PartDocument
	      prt = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Sheet Metal.ipt", True)
  ' Store solid body name
	  Dim p As String
	      p = sb.Name
  ' Set new part display name !!! Not the same as new part file name 	  
		  prt.DisplayName = p     
  ' Derived solid body  
	  Dim dpcs As DerivedPartComponents
	      dpcs = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents
	  Dim dpd As DerivedPartUniformScaleDef
	      dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)
  ' Exclude the other solid bodies
	  Dim dpe As DerivedPartEntity
	      For Each dpe In dpd.Solids
	        If Not dpe.ReferencedEntity Is sb Then
	               dpe.IncludeEntity = False
      End If
   Next
   ' Export derived solid body 
   dpcs.Add(dpd)
   ' Determine new part type 
   If prt.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
  	  prt = ThisApplication.ActiveDocument
   ' Copy and activate sheet metal style from master part to new part, unfold the new part  
	  Dim oPrtSheetMetalCompDef As SheetMetalComponentDefinition = prt.ComponentDefinition
	      oPrtSheetMetalCompDef.SheetMetalStyles.Item("Tabla 1mm").Copy("Tabla 1mm") 'don't know how to read the master part active sheet metal style name si i cand use it
		  oPrtSheetMetalCompDef.SheetMetalStyles.Item("Tabla 1mm").Activate()
	      oPrtSheetMetalCompDef.Unfold()
   ' Custom DXF Flat Pattern settings, here u can edit them '
	  Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=Burn&InteriorProfilesLayer=Burn&FeatureProfilesDownLayerColor=0;128;255&FeatureProfilesUpLayerColor=255;0;0&InvisibleLayers=IV_UNCONSUMEND_SKETCHES;IV_ALTREP_BACK;IV_ALTREP_FRONT;IV_ARC_CENTERS;IV_TOOL_CENTER_DOWN;IV_TOOL_CENTER;IV_ARC_CENTERS;IV_TANGENT;IV_BEND;IV_BEND_DOWN&SplineTolerance Double 0.001&MergeProfilesIntoPolyline=True"
   ' DXF file name, export DXF, exit Flat Pattern 
	  Dim DxfName As String = sb.Name & ".dxf"
	      oPrtSheetMetalCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & DxfName)
		  oPrtSheetMetalCompDef.FlatPattern.ExitEdit()
	  End If
   ' Save new part !!! Name is master part name + solid bodies name  
   prt.SaveAs(f + doc.DisplayName.Replace(".ipt", " ") + sb.Name + ".ipt", False)
   ' Place an instance of it inside the assembly
   Dim mx As Matrix
       mx = ThisApplication.TransientGeometry.CreateMatrix()
       asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
   ' Don't need it anymore
   prt.Close
      End If
   Next
   ' Save assembly and close it !!! Same name as master part   
	  asm.SaveAs(f + doc.DisplayName.Replace(".ipt", ".iam"), False)
      asm.Close
End Sub

gerrardhickson · ‎10-01-2023

Ok - I haven't looked into it too deeply, but I think I see the problem.
It seems that you're intending to 'copy' the sheet metal style from the parent assembly to the new part. That doesn't work. Keep in mind that you're using code to replicate the process that you would take manually - and that process is to export the style to an .xml file, and then import it to your new part. Practically speaking, this is a little clunky, a better approach is to add the style to your template file manually before the (assuming that you only have a few styles to work with).

Finally, once your style is loaded into the template file, just activate it with the line below, as you're already doing.

oPrtSheetMetalCompDef.SheetMetalStyles.Item("Tabla 1mm").Activate()

Hope that helps.

mecanicu · ‎10-02-2023

I manage to resolve the sheet metal style problem. Now it's working as external rule as well. Here is the final code:

 
' Run this inside a Multi-Solid part; Custom for Multi-Solid Sheet Metal Part
Sub Main()
  ' Determine master part type, store sheet metal style name and save style to global 
  Dim doc As PartDocument = ThisApplication.ActiveDocument
  Dim styleName As String   
      If doc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
      Dim oDocSheetMetalCompDef As SheetMetalComponentDefinition = doc.ComponentDefinition
      Dim oDocSheetMetalStyle As SheetMetalStyle = oDocSheetMetalCompDef.ActiveSheetMetalStyle
	  styleName = oDocSheetMetalStyle.Name
	  oDocSheetMetalStyle.SaveToGlobal()
	  End If
  ' Same Folder as Master Part to place the new components:
  ' assembly and subcomponents
  Dim f As String 
      f = ThisDoc.Path & "\" 
  ' Templates Folder
  Dim oTemplatesPath As String 
      oTemplatesPath = "C:\Users\Public\Documents\Autodesk\Inventor 2023\Templates\en-US"
  ' Make Folder for DFX export !!! folder name is master part name & DXF File
  Dim oFolder As String = f & doc.DisplayName.Replace(".ipt", " DXF File")
  Dim fso As Object
      fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(oFolder) Then fso.CreateFolder(oFolder)
  ' Create the assembly, select assembly template 
  Dim asm As AssemblyDocument
      asm = ThisApplication.Documents.Add(kAssemblyDocumentObject, oTemplatesPath & "\SheetMetalDXF.iam", True)
  ' Iterate through solid bodies
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
  ' See if the solid body is visible
      If sb.Visible Then
  ' Create new part for each solid body, , select part template
	  Dim prt As PartDocument
	      prt = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Sheet Metal.ipt", True)
  ' Store solid body name
	  Dim p As String
	      p = sb.Name
  ' Set new part display name !!! Not the same as new part file name 	  
		  prt.DisplayName = p     
  ' Derived solid body  
	  Dim dpcs As DerivedPartComponents
	      dpcs = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents
	  Dim dpd As DerivedPartUniformScaleDef
	      dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)
  ' Exclude the other solid bodies
	  Dim dpe As DerivedPartEntity
	      For Each dpe In dpd.Solids
	        If Not dpe.ReferencedEntity Is sb Then
	               dpe.IncludeEntity = False
      End If
   Next
   ' Export derived solid body 
   dpcs.Add(dpd)
   ' Determine new part type 
   If prt.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
  	  prt = ThisApplication.ActiveDocument
   ' Activate sheet metal style from master part to new part, unfold the new part  
	  Dim oPrtSheetMetalCompDef As SheetMetalComponentDefinition = prt.ComponentDefinition
	      oPrtSheetMetalCompDef.SheetMetalStyles.Item(styleName).Activate()
	      oPrtSheetMetalCompDef.Unfold()
   ' Custom DXF Flat Pattern settings, here u can edit them '
	  Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=Burn&InteriorProfilesLayer=Burn&FeatureProfilesDownLayerColor=0;128;255&FeatureProfilesUpLayerColor=255;0;0&InvisibleLayers=IV_UNCONSUMEND_SKETCHES;IV_ALTREP_BACK;IV_ALTREP_FRONT;IV_ARC_CENTERS;IV_TOOL_CENTER_DOWN;IV_TOOL_CENTER;IV_ARC_CENTERS;IV_TANGENT;IV_BEND;IV_BEND_DOWN&SplineTolerance Double 0.001&MergeProfilesIntoPolyline=True"
   ' DXF file name, export DXF, exit Flat Pattern 
	  Dim DxfName As String = sb.Name & ".dxf"
	      oPrtSheetMetalCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & DxfName)
		  oPrtSheetMetalCompDef.FlatPattern.ExitEdit()
	  End If
   ' Save new part !!! Name is master part name + solid bodies name  
   prt.SaveAs(f + doc.DisplayName.Replace(".ipt", " ") + sb.Name + ".ipt", False)
   ' Place an instance of it inside the assembly
   Dim mx As Matrix
       mx = ThisApplication.TransientGeometry.CreateMatrix()
       asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
   ' Don't need it anymore
   prt.Close
      End If
   Next
   ' Save assembly and close it !!! Same name as master part   
	  asm.SaveAs(f + doc.DisplayName.Replace(".ipt", ".iam"), False)
      asm.Close
End Sub

gerrardhickson · ‎10-03-2023

Nice work.

p_kompier · ‎07-23-2024

Dear Mecanicu,

The rule you created works well for my intentions which is to create an assy from a multi-bodied part, but does it also happen to you that patterned or mirrored parts don't have the solid included in the derived part?

All the other parts have a small green arrow in the derived part browser but my mirrored part does not.

Please find attached a screenshot of the derived part browser and the modded code.

Here is your code that I have modified to see if it can serve my needs.

' Folder to place the new assembly and parts

Dim path As String: path = ThisDoc.Path & "/"

' Use the docs first 9 characters as prefix for the new filenames

Dim prefix As String: prefix = Left(ThisDoc.FileName(False), 9)

Dim doc As PartDocument

doc = ThisApplication.ActiveDocument

' Create new assembly

Dim assy As AssemblyDocument

assy = ThisApplication.Documents.Add(kAssemblyDocumentObject)

Dim sBody As SurfaceBody

For Each sBody In doc.ComponentDefinition.SurfaceBodies

' Create a part for each surfacebody

Dim prt As PartDocument

prt = ThisApplication.Documents.Add(kPartDocumentObject)

Dim dpcs As DerivedPartComponents

dpcs = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents

Dim dpd As DerivedPartUniformScaleDef

dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)

' Exclude the other solid bodies

Dim dpe As DerivedPartEntity

For Each dpe In dpd.Solids

If Not dpe.ReferencedEntity Is sBody Then

dpe.IncludeEntity = False

End If

dpe.IncludeEntity = False

' Save using prefix and solid body's name

Call prt.SaveAs(path + prefix + sBody.Name + ".ipt", False)

' Place an instance of it inside the assembly

Dim mx As Matrix

mx = ThisApplication.TransientGeometry.CreateMatrix()

Call assy.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)

' Close the part

Call prt.Close

Call assy.SaveAs(path + prefix + "001" + ".iam", False)

Many thanks in advance, I hope this mystery can be solved.

Make Assembly from Multi Body Part with custom naming!

Make Assembly from Multi Body Part with custom naming!

Forums Links

Post to forums