在部件环境中，部件中选个零件或者部件，修改对应的零件部件文件名，并同步更改工程图文件名。鼠标先选择零件 再运行。
- Imports File = System.IO.File
- Imports Path = System.IO.Path
- '在部件环境中，部件中选个零件或者部件，修改对应的零件部件文件名，并同步更改工程图文件名
- '鼠标先选择零件 再运行
- Sub Main()
- If ThisDoc.Document.DocumentType = kPartDocumentObject Then
- MsgBox("仅在部件环境中使用！")
- Return
- End If
- On Error Resume Next
- Dim oDrawDoc As DrawingDocument
- Dim oOcc As ComponentOccurrence
- oOcc = ThisApplication.ActiveDocument.SelectSet.Item(1)
- If Err.Number <> 0 Then
- MsgBox("你必须选择一个零件！")
- Exit Sub
- End If
- On Error GoTo 0
- Dim oDoc = oOcc.Definition.Document
- Err.Clear
- filepath = oDoc.fullfilename '获得全路径名称
- Dim oFileName = IO.Path.GetFileNameWithoutExtension(filepath) '获取无扩展名的名称 ( returns: 1234)
- FName = InputBox("零件名称是:", "请输入...", oFileName)
- If FName = "" Then
- FName = oldname
- MsgBox("名称不能为空！")
- Return
- End If
- If FName = oFileName Then
- MsgBox("名称不能为之前名称！或者相同")
- Return
- End If
- On Error Resume Next
- PP = IO.Path.GetDirectoryName(filepath) '得到的路径 (returns: C:\Temp\Test)
- Dim oExt = IO.Path.GetExtension(filepath) '得到扩展 ( returns: .ipt)
- Dim pathstr = PP + "" + FName + oExt
- If File.Exists(pathstr) Then
- MsgBox("已存在同名文件！")
- Else
- Err.Clear
- oDoc.SaveAs(pathstr, True)
- oOcc.Replace(pathstr, True)
- My.Computer.FileSystem.DeleteFile(filepath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin, FileIO.UICancelOption.DoNothing)
- Dim newStockNum As String = InputBox("新物料号(Part Number)：", "属性填写")
- iProperties.Value(FName & oExt, "Project", "Part Number") = newStockNum
- iProperties.Value(FName & oExt, "Project", "Stock Number") = newStockNum
- Call idwdrawingnamechangefx(filepath, pathstr)'调用idw工程图修改子函数
- Call dwgdrawingnamechangefx(filepath, pathstr)'调用dwg工程图修改子函数
- Err.Clear
- End If
- End Sub
- Sub idwdrawingnamechangefx(ByRef oldModelPath, ByRef NewModelPath)
- Dim oldDrawingPath As String
- Dim NewDrawingPath As String
- oldDrawingPath = Strings.Left(oldModelPath, Strings.Len(oldModelPath) -3) + "idw" '老工程图路径
- NewDrawingPath = Strings.Left(NewModelPath, Strings.Len(NewModelPath) -3) + "idw" '新工程图路径
- IO.File.Copy(oldDrawingPath, NewDrawingPath)'复制工程图新的到指定路径
- Dim oDrawDoc As DrawingDocument
- oDrawDoc = ThisApplication.Documents.Open(NewDrawingPath, True)'打开复制后新工程图(打开窗口不显示)
- Dim oFD As FileDescriptor
- oFD = oDrawDoc.File.ReferencedFileDescriptors(1)
- oFD.ReplaceReference(NewModelPath)' 替换引用文档为改名后的模型文档
- My.Computer.FileSystem.DeleteFile(oldDrawingPath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin, FileIO.UICancelOption.DoNothing)'删除旧工程图
- oDrawDoc.Close(False)' 保存修改并关闭工程图
- End Sub
- Sub dwgdrawingnamechangefx(ByRef oldModelPath, ByRef NewModelPath)
- Dim oldDrawingPath As String
- Dim NewDrawingPath As String
- oldDrawingPath = Strings.Left(oldModelPath, Strings.Len(oldModelPath) -3) + "dwg" '老工程图路径
- NewDrawingPath = Strings.Left(NewModelPath, Strings.Len(NewModelPath) -3) + "dwg" '新工程图路径
- IO.File.Copy(oldDrawingPath, NewDrawingPath)'复制工程图新的到指定路径
- Dim oDrawDoc As DrawingDocument
- oDrawDoc = ThisApplication.Documents.Open(NewDrawingPath, True)'打开复制后新工程图(打开窗口不显示)
- Dim oFD As FileDescriptor
- oFD = oDrawDoc.File.ReferencedFileDescriptors(1)
- oFD.ReplaceReference(NewModelPath)' 替换引用文档为改名后的模型文档
- My.Computer.FileSystem.DeleteFile(oldDrawingPath, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin, FileIO.UICancelOption.DoNothing)'删除旧工程图
- oDrawDoc.Close(False)' 保存修改并关闭工程图
- End Sub
|
