solidworks 关联图纸重命名文件
solidworks真是不思进取，连个关联图纸一起重命名的功能都没有，但这并不是因为它不能实现，只是因为开发根本就不能从用户实际需求去考虑问题，你文件另存为的时候直接关联上同名的图纸文件不就完了吗，只能自己写个宏文件，需要的朋友自己copy一下吧。Dim swApp As Object
Dim ActiveDoc As Object
Dim Error As Long
Dim Warning As Long
Dim NewName As String
Dim NewPathName As String
Dim Status As Boolean
Dim vDepend() As String
Sub main()
Set swApp = Application.SldWorks
Set ActiveDoc = swApp.ActiveDoc
Set swSelMgr = ActiveDoc.SelectionManager
Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0)
'判断是否选择了当前文件子装配体对象
If swSelMgr.GetSelectedObjectCount2(0) = 0 Then
MsgBox "当前功能只能对装配体里的子文件进行重命名", vbOKOnly, "提示信息"
Else
swComp.SetSuppression2 (3)
Set swSelModel = swComp.GetModelDoc2
Set swSelModelext = swSelModel.Extension
OldPathName = swComp.GetPathName
Path = Left(OldPathName, InStrRev(OldPathName, "\")) '路径
Suffix = Mid(OldPathName, InStrRev(OldPathName, ".")) '后缀
OldNameWithSuffix = Mid(OldPathName, InStrRev(OldPathName, "\") + 1) '带后缀的旧文件名
OldName = Left(OldNameWithSuffix,InStrRev(OldNameWithSuffix,".")-1)
NewName = InputBox("另存为新文件名：","更新文件名对话框",OldName)'输入新文件名
NewPathName = Path & NewName & Suffix '新文件名带路径
If NewPathName <> "" And NewName <> OldName Then
Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning) '将旧文件直接另存为新文件
Kill OldPathName '删除旧文件
temFile = Dir(Path & OldName & ".SLDDRW") '只要返回值不为空就表明该文件是有工程图纸的，返回值是有后缀的文件名
If temFile <> "" Then
NewDrwName = Path & NewName & ".SLDDRW"
OldDrwName = Path & OldName & ".SLDDRW"
FileCopy OldDrwName , NewDrwName '复制工程图为新文件
vDepend = swApp.GetDocumentDependencies2(OldDrwName, False, False, False) '查找旧文件工程图依赖
Rp = swApp.ReplaceReferencedDocument(NewDrwName, vDepend(1), NewPathName) '替换工程图依赖
Kill OldDrwName
Else
MsgBox "文件没有工程图纸", vbOKOnly, "提示信息"
End If
Else
MsgBox "无效的新文件名，请冲洗输入", vbOKOnly, "提示信息"
End If
End If
End Sub
这个怎么用？ 请冲洗输入？重新输入吧？ Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning)这段一直报错 复制的里面有些叽里呱啦的文字怎么删除？ 比如 t# m' |. _% d9 q: W- [4 o( \2 b* p6 V4 P8 m
页:
[1]