Hey there! Thanks for checking out my post.
I'm currently learning iLogic to try to increase Automation for my company's workflow. I've attached a document that basically outlines where we see this going. There's also a picture that demonstrates the sheet metal panels we manufacture. The reason I'm writing the code is because it takes too much time to manually rename all objects in the iCopy process. So I want to accept the default names and save locations and reorganize the references into a single folder.
I hope to write a code that will accomplish the following:
Eventually I will need to figure out how to reassociate the drawing files with the new copied references. But I have no idea how. An alternative would be to use iLogic to make new drawing files for each occurrence in the assembly, but I'm still not sure how to do that.
Below is a snippet of how far I got with Chat GPT. It got me part of the way through my goal but trying to add new functions was unsuccessful no matter what I tried. I'm willing to bet there's a more efficient way to approach this than what Chat GPT came up with. Would anyone be kind enough to spare some time to help me?
Sub Main()
' Prompt user to select a folder
Dim folderDialog As Object
folderDialog = CreateObject("Shell.Application").BrowseForFolder(0, "Select a folder", 0, 0)
If folderDialog Is Nothing Then
MsgBox( "No folder selected. Exiting script.", vbExclamation, "No Folder Selected")
Exit Sub
End If
Dim selectedFolder As String
selectedFolder = folderDialog.Self.Path
' Prompt user for project number
Dim projectNumber As String
projectNumber = UCase(InputBox("Enter project number:", "Project Number Input"))
' Prompt user for panel group
Dim panelGroup As String
panelGroup = UCase(InputBox("Enter panel group:", "Panel Group Input"))
' Get the active assembly document
Dim asmDoc As AssemblyDocument
asmDoc = ThisApplication.ActiveDocument
Dim asmCompDef As AssemblyComponentDefinition
asmCompDef = asmDoc.ComponentDefinition
Dim occurrences As ComponentOccurrences
occurrences = asmCompDef.Occurrences
Dim count As Integer
count = 1
Dim updatedAssemblyCount As Integer
updatedAssemblyCount = 0 ' Counter to track updated assemblies
Dim foundSubassembly As Boolean
foundSubassembly = False ' Flag to track if any subassemblies were found
' Iterate through each occurrence
For Each occurrence As ComponentOccurrence In occurrences
If occurrence.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
' Get the subassembly document
Dim subassemblyDoc As AssemblyDocument
subassemblyDoc = occurrence.Definition.Document
' Generate sequential suffix
Dim suffix As String
suffix = count.ToString("000")
count = count + 1
' Combine project number, panel group, and suffix to create new part number
Dim newPartNumber As String
newPartNumber = projectNumber & "-" & panelGroup & "-PANEL-" & suffix
' Update display name
occurrence.Name = newPartNumber
' Update part number property
iProperties.Value(occurrence.Name, "Project", "Part Number") = newPartNumber
' Check and rename specific parts within the subassembly
For Each subOcc As ComponentOccurrence In subassemblyDoc.ComponentDefinition.Occurrences
If subOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim partName As String
partName = UCase(subOcc.Name) ' Convert to uppercase for case-insensitive comparison
' Check if part name contains 'LP' or 'ACM' (case insensitive) and rename accordingly
If partName Like "*LP*" Then
Dim newSubPartNumber As String
newSubPartNumber = projectNumber & "-" & panelGroup & "-LP-" & suffix
subOcc.Name = newSubPartNumber
iProperties.Value(subOcc.Name, "Project", "Part Number") = newSubPartNumber ' Update part number property
' Rename and copy the file
RenameAndCopyFile( subOcc, newSubPartNumber, selectedFolder)
ElseIf partName Like "*ACM*" Then
Dim newSubPartNumber As String
newSubPartNumber = projectNumber & "-" & panelGroup & "-ACM-" & suffix
subOcc.Name = newSubPartNumber
iProperties.Value(subOcc.Name, "Project", "Part Number") = newSubPartNumber ' Update part number property
' Rename and copy the file
RenameAndCopyFile( subOcc, newSubPartNumber, selectedFolder)
End If
End If
Next
updatedAssemblyCount = updatedAssemblyCount + 1 ' Increment count of updated assemblies
foundSubassembly = True ' Set flag to true since we found at least one subassembly
End If
Next
' Show message if no subassemblies were found
If Not foundSubassembly Then
MsgBox( "No subassemblies or occurrences were found in the assembly.", vbExclamation, "No Components Found")
Else
' Display message with count of updated assemblies
MsgBox( updatedAssemblyCount & " components updated.", vbInformation, "Update Complete")
End If
End Sub
' Function to rename and copy the part file to the selected folder
Sub RenameAndCopyFile(occurrence As ComponentOccurrence, newPartNumber As String, folderPath As String)
On Error Resume Next ' Error handling
Dim partDoc As Document
partDoc = occurrence.Definition.Document
Dim partFilePath As String
partFilePath = partDoc.FullFileName
Dim fso As Object
fso = CreateObject("Scripting.FileSystemObject")
' Get the current file path and filename
Dim currentFilePath As String
currentFilePath = partDoc.FullFileName
Dim currentFileName As String
currentFileName = fso.GetFileName(currentFilePath)
' Get the new file path in the target folder
Dim newFileName As String
newFileName = newPartNumber & "." & fso.GetExtensionName(currentFileName)
Dim newFilePath As String
newFilePath = fso.BuildPath(folderPath, newFileName)
' Copy the file to the selected target folder if not already there
If Not fso.FileExists(newFilePath) Then
fso.CopyFile( currentFilePath, newFilePath, True)
End If
' Rename the file in the target folder (if needed)
If fso.FileExists(newFilePath) Then
fso.MoveFile( newFilePath, fso.BuildPath(folderPath, newFileName))
End If
' Clean up
fso = Nothing
End Sub
Can't find what you're looking for? Ask the community or share your knowledge.