规则也很好理解，逻辑如下。
1. 用AllReferencedDocument一次性得到目标零部件的所有引用文件，全部复制。
2. 依次打开所有复制文件，并替换其第一级的引用（ReplaceReference）
就这么简单。代码如下。
其中FileName，FolderName，oB为零部件参数。
例：FileName = "C:\test\A.iam"
FolderName = "C:\Copy"
oB = "_1"
运行代码，则会将A.iam设计复制到C:\Copy文件夹中。
- Sub Main
- Dim List1 As ArrayList = New ArrayList()
- Dim oDoc As Document
- Dim oDoc2 As Document
-
- oDoc = ThisApplication.Documents.Open(FileName, False)
-
- oMainFullNameCopy = Filecopyfunc(oDoc.FullDocumentName, True)
- List1.Add(oMainFullNameCopy)
-
- For Each oSubDoc In oDoc.AllReferencedDocuments
- oFullName0 = oSubDoc.FulldocumentName
- oFullNameCopy0 = Filecopyfunc(oFullName0, True)
- List1.Add(oFullNameCopy0)
- Next
- oDoc.close
-
- For Each oFNC In List1
- oSave = False
- oDoc2 = ThisApplication.Documents.Open(oFNC, False)
- If oDoc2.File.ReferencedFileDescriptors.Count <> 0 Then
- oFileDesEnu = oDoc2.File.ReferencedFileDescriptors
- For Each oFileDes In oFileDesEnu
- oFullName2 = oFileDes.FullFileName
- oFullNameCopy2 = Filecopyfunc(oFullName2, False)
- If Dir(oFullNameCopy2) <> "" Then
- oFileDes.ReplaceReference(oFullNameCopy2)
- oSave = True
- End If
- Next
- if oSave = True then oDoc2.save
- End If
- oDoc2.close
- Next
- End Sub
- Function Filecopyfunc(oFullName,oCopy)
- NN = InStr(StrReverse(oFullName), ".")
- AA = Left(oFullName, Len(oFullName) - NN)
- BB = Right(oFullName, NN)
- NN = InStr(StrReverse(AA), "")
- If NN <> 0 Then oName = Right(AA, NN - 1) Else oName = AA
-
- CopyFolder = FolderName
- If Dir(CopyFolder,vbDirectory) = "" Then MkDir(CopyFolder)
-
- oFullNameCopy = CopyFolder & "" & oName & oB & BB
- If oCopy = True Then
- FileCopy(oFullName, oFullNameCopy)
- End If
- Filecopyfunc = oFullNameCopy
- End Function
|
