1.Select a part or assembly in the model tree within the component. 2.Run the rule, and enter the new filename. 3.The rule will save a copy of the model and project under the new filename. 4.Re-link the component with the new filename, and re-link the engineering drawings with the new filename. 5.Delete the original file and save the document. In general, this iLogic should not cause issues. However, there might be an issue in the following scenario: A base component (A), and a derivative of the base component (B). When both components are in the assembly at the same time, and A is renamed, after saving, B is unable to automatically establish a link with A. How should the code be modified? Attached are the test files and the original ILOGIC code.
imports File = System.IO.File
Imports Path = System.IO.Path
Sub Main()
' 验证活动文档是否为装配体
If ThisDoc.Document.DocumentType <> kAssemblyDocumentObject Then
MsgBox("此操作只在装配体环境中有效！", vbCritical, "DWJ")
Return
End If
' 尝试获取装配体中选定的零件实例
Dim selectedOccurrence As ComponentOccurrence
If ThisApplication.ActiveDocument.SelectSet.Count > 0 Then
If TypeOf ThisApplication.ActiveDocument.SelectSet.Item(1) Is ComponentOccurrence Then
selectedOccurrence = ThisApplication.ActiveDocument.SelectSet.Item(1)
Else
MsgBox("所选内容不是一个组件实例！", vbCritical, "DWJ")
Exit Sub
End If
Else
MsgBox("请选择一个组件！", vbCritical, "DWJ")
Exit Sub
End If
If selectedOccurrence Is Nothing Then
MsgBox("请选择一个组件！", vbCritical, "DWJ")
Exit Sub
End If
' 使用选定实例的文档定义
Dim documentToRename As Document
documentToRename = selectedOccurrence.Definition.Document
' 获取文档的完整文件路径
Dim fullPath As String = documentToRename.FullFileName
Dim currentFileName As String = Path.GetFileNameWithoutExtension(fullPath)
' 弹出输入框让用户输入新文件名
Dim newFileName As String
newFileName = InputBox("原文件名: " & currentFileName, "请输入新文件名称", currentFileName)
If newFileName = "" Then
MsgBox("文件名不能为空！", vbCritical, "DWJ")
Return
End If
If newFileName = currentFileName Then
MsgBox("新文件名不能与原文件名相同！", vbCritical, "DWJ")
Exit Sub
End If
' 确定新的文件路径
Dim directoryPath As String = Path.GetDirectoryName(fullPath)
Dim extension As String = Path.GetExtension(fullPath)
Dim newPath As String = Path.Combine(directoryPath, newFileName & extension)
' 检查是否已经存在同名文件
If File.Exists(newPath) Then
MsgBox("已存在同名文件！", vbExclamation, "DWJ")
Exit Sub
End If
' 以新名称保存文档并更新属性
documentToRename.SaveAs(newPath, False)
' 更新引用此文档的所有文档
UpdateReferencingDocuments(documentToRename)
selectedOccurrence.Replace(newPath, True)
' 删除原始文件
File.Delete(fullPath)
' 更新部件编号和显示名称
documentToRename.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value = newFileName
documentToRename.DisplayName = newFileName
End Sub
' 新增加的子程序用于更新所有引用
Sub UpdateReferencingDocuments(ByVal partDocument As Document)
Dim referencingDocs As DocumentsEnumerator
referencingDocs = partDocument.ReferencingDocuments
Dim refDoc As Document
For Each refDoc In referencingDocs
Dim refOccs As ComponentOccurrencesEnumerator
refOccs = refDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(partDocument)
Dim refOcc As ComponentOccurrence
For Each refOcc In refOccs
' refOcc.Definition.Document.SaveAs(refOcc.Definition.Document.FullDocumentName, False) ' 保存每个引用文档
refOcc.Replace(refOcc.Definition.Document.FullDocumentName, True) ' 更新引用
Next
Next
End Sub
