ILOGIC "Make Components" Automation no Longer Working.

[CHAINES19]

A much older post listed here no longer works after about 8 months.

I cant quite figure out what could possibly go wrong but it no longer places each solid body in its own part file. Any ideas on how to fix this?

' Run this inside a Multi-Solid part
Sub MakeComponentsProgrammatically()
  ' Folder to place the new components:
  ' assembly and subcomponents
  Dim f As String: f = "C:\temp\test1\"
  
  ' Make sure the folder exists
  Dim fso As Object
  Set fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(f) Then Call fso.CreateFolder(f)
  
  Dim doc As PartDocument
  Set doc = ThisApplication.ActiveDocument
  
  ' Create the assembly
  Dim asm As AssemblyDocument
  Set asm = ThisApplication.Documents.Add(kAssemblyDocumentObject)
  
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
    ' Create part for each body
    Dim prt As PartDocument
    Set prt = ThisApplication.Documents.Add(kPartDocumentObject)
    
    ' Set iProperties >> Project >> Description
    ' It's inside "Design Tracking Properties"
    Dim p As Property
    Set p = prt.PropertySets( _
      "{32853F0F-3444-11D1-9E93-0060B03C1CA6}")("Description")
    p.Expression = sb.name
    
    Dim dpcs As DerivedPartComponents
    Set dpcs = prt.ComponentDefinition.ReferenceComponents. _
      DerivedPartComponents
    
    Dim dpd As DerivedPartUniformScaleDef
    Set 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
    
    Call dpcs.Add(dpd)
    
    ' Could have any name but we use the solid body's name
    Call prt.SaveAs(f + sb.name + ".ipt", False)
        
    ' Place an instance of it inside the assembly
    Dim mx As Matrix
    Set mx = ThisApplication.TransientGeometry.CreateMatrix()
    Call asm.ComponentDefinition.Occurrences. _
      AddByComponentDefinition(prt.ComponentDefinition, mx)
    
    ' Don't need it anymore
    Call prt.Close
  Next
  
  Call asm.SaveAs( _
    f + Left(doc.DisplayName, Len(doc.DisplayName) - 4) + _
    ".iam", False)
  Call asm.Close
End Sub

[A.Acheson]

Just wondering what inventor version are you using? And also are you using VBA or iLogic editor? Your title is saying ilogic but your code says VBA. Also if you can supply the more info tab of any error message and also indicate where you might think it is failing. 

[CHAINES19]

Im using Build 350, Release 2022.3

I converted the code to ILOGIC by removing the sub and set text, I just posted what was listed in the form I linked to.

There are no error codes, it simply never places each solid body in the new part file.

[A.Acheson]

Here is an ilogic version. Let us know if it works.

'Run this inside a Multi-Solid part.
Sub Main
	
  'Folder to place the new components,assembly and subcomponents.
  Dim folder As String = ThisDoc.Path & "\MakeComponents\"
    
  'Make sure the folder exists.
  If Not IO.Directory.Exists(folder) Then IO.Directory.CreateDirectory(folder)

  Dim doc As PartDocument = ThisApplication.ActiveDocument
  
  'Create the assembly
  Dim asm As AssemblyDocument = ThisApplication.Documents.Add(kAssemblyDocumentObject)

  For Each sb As SurfaceBody In doc.ComponentDefinition.SurfaceBodies
    
		'Create part for each body
		Dim prt As PartDocument = ThisApplication.Documents.Add(kPartDocumentObject)

		'iProperties >> Project >> Description.
		Dim Desc As [Property] = prt.PropertySets("Design Tracking Properties").Item("Description")
		Desc.Value = sb.Name

		Dim dpcs As DerivedPartComponents = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents

		Dim dpd As DerivedPartUniformScaleDef = dpcs.CreateUniformScaleDef(doc.FullDocumentName)

		dpd.ExcludeAll

		'Include the solid bodies.
		For Each dpe As DerivedPartEntity In dpd.Solids
			If dpe.ReferencedEntity Is sb Then dpe.IncludeEntity = True
		Next

		dpcs.Add(dpd)

		'Could have any name but we use the solid body's name.
		prt.SaveAs(folder + sb.Name + ".ipt", False)
		    
		'Place an instance of it inside the assembly.
		Dim mx As Matrix = ThisApplication.TransientGeometry.CreateMatrix()

		asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
		
		'Don't need it anymore.
		prt.Close
  Next
  
    asm.SaveAs(folder + Left(doc.DisplayName, Len(doc.DisplayName) - 4) + ".iam", False)
    asm.Close
End Sub

[CHAINES19]

Still doesnt work, It creates the assembly and part files but does not place the solid body in it.

[A.Acheson]

I tested it on 2022 and 2020 and it worked. Maybe someone else can check a 2023 trial assembly. So the assembly is empty? Are the parts created normally? 

[CHAINES19]

It seems to not work on specific part files, any idea what could be causing that?

Some ipt files will have all their solid bodies extract and others wont work at all.

[A.Acheson]

In the version you posted I noticed that if a solid body was changed after creation to be a seperate body or to be part of an existing one it wasn't functioning. The version I posted doesn't seem to do that but I can check again on 2022 and see as I didn't get to test that version with different criteria . Maybe what's wrong is it's not recognizing what solid is to be added. Maybe you can switch off all options.

The lines in question are these guys. 

dpd.ExcludeAll

		'Include the solid bodies.
		For Each dpe As DerivedPartEntity In dpd.Solids
			If dpe.ReferencedEntity Is sb Then dpe.IncludeEntity = True
		Next

		dpcs.Add(dpd)

[CHAINES19]

As a final note, I did end up solving this. On some solid body names I wanted to exlcude them from the extraction process so I had a line saying 

If Instr(sb.Name,"_") = 1
Else

Which worked for a long time but seems to glitch if you copy an part drawing and rename again, it would still think EVERYTHING is a duplicate for some reason and not extract ANY solid bodies. Was fixed to this:

If Instr(sb.Name,"DUPLICATE") = 1
Else

very strange.

[StewartFuchs]

Thanks for posting this code. I used it in INV2023 and it goes through the motions of creating the parts and assembly, but then, nothing, as others have stated above. So I changed the code (in line 38, change False to True) as shown below, and it works a treat. Then you just rename the part files in Design Assistant.