contentcenter标准件保存当前路径V1 之前保存过会替换参考 无需考虑丢失参考链接 ，保存本地路径更加安全不易丢失，且可直接编辑！

[858456055]

'Sub Main() 'Programming by DWJ 2021.11.23 China Tianchang city (V4.1). Thanks for Autodesk Rocky and Jane to give me very important help！Just for best inventor ！ QQ二次发开交流群：951736200 'oDoc = ThisApplication.ActiveDocument 'Dim sure = MsgBox("确定继续？", vbYesNo, "Autodesk Inventor ilogic") 'If sure = vbYes Then ' Call contencentersavefx(oDoc) ' On Error Resume Next ' oDoc.Rebuild() ' oDoc.save ' Err.Clear ' MsgBox("All done！", , "contencenter零件保存本地") ' Return 'Else ' Return 'End If 'End Sub 'Sub contencentersavefx(ByVal ooDoc) ' Dim osubdoc As Document ' For Each osubdoc In ooDoc.AllReferencedDocuments ' On Error Resume Next ' Dim oName = ThisDoc.Document.FullFileName '例子: C:\Temp\Test\1234.ipt 总装全路径名称 ' Dim oPath = IO.Path.GetDirectoryName(oName) '得到的路径 (returns: C:\Temp\Test) 总装文件夹路径名称 ' Dim osubdocName = osubdoc.FullFileName '例子: C:\Temp\Test\1234.ipt ' Dim oFileName = IO.Path.GetFileName(osubdocName) '获取扩展名的名称 (returns: 1234.ipt) ' Dim newpath = oPath + "\" + oFileName '新路径名（保存总装路径下） ' Dim oIsContentMember = osubdoc.ComponentDefinition.IsContentMember() ' If oIsContentMember = True Then ' ' My.Computer.FileSystem.DeleteFile(newpath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin, FileIO.UICancelOption.DoNothing) ' MsgBox(newpath) ' osubdoc.SaveAs(newpath, False) ' End If ' Err.Clear ' Next 'End Sub Sub Main() oDoc = ThisApplication.ActiveDocument Dim sure = MsgBox("确定继续？", vbYesNo, "Autodesk Inventor ilogic") If sure = vbYes Then Call contencentersavefx(oDoc.ComponentDefinition) oDoc.Rebuild() oDoc.save MsgBox("All done！", , "contencenter零件保存本地") Return Else Return End If End Sub Sub contencentersavefx(ByVal ooDoc As ComponentDefinition) On Error Resume Next Dim oPrds = ooDoc.Occurrences If oPrds.Count>0 Then Dim prdl As ComponentOccurrence For N = 1 To oPrds.Count Step 1 prdl = oPrds.Item(N) Dim ocdoc = prdl.Definition.Document Dim oName = ThisDoc.Document.FullFileName '例子: C:\Temp\Test\1234.ipt Dim oPath = IO.Path.GetDirectoryName(oName) '得到的路径 (returns: C:\Temp\Test) Dim osubdocName = ocdoc.FullFileName '例子: C:\Temp\Test\1234.ipt Dim oFileName = IO.Path.GetFileName(osubdocName) '获取扩展名的名称 ( returns: 1234.ipt) Dim newpath = oPath + "\" + oFileName Dim oIsContentMember = ocdoc.ComponentDefinition.IsContentMember() If oIsContentMember = True Then prdl.Replace(newpath, True) ' MsgBox(newpath) ocdoc.SaveAs(newpath, False) End If If prdl.SubOccurrences.Count > 0 Then Call contencentersavefx(prdl.Definition) End If Next End If End Sub

[chenj]

不是很清楚这段代码的作用。在Inventor中，标准件可以设置自动保存到某个路径，或者作为自定义零件保存，是不是和这段代码的作用是一样的？

[858456055]

对是一样的，但是解决了之前保存过 同名不能再保存问题，其次是批量保存到本地

[Yong.Jing]

看来文件后才明白您的意图。 

建议您将第一个帖子的格式编辑一下，或直接上程序的截图。 这样看起来更清晰。