重命名零件宏

怕瓦落地2011 · 发表于 2023-8-21 21:07:44

Solidworks 虽功能强大，但有些地方做得不尽如人意，比如三维带工程图重命名，就显得十分鸡肋。必威APP精装版下载网友steve_suich发过一个改零件同时改工程图的宏（//www.szfco.com/thread-1058539-1-2.html）,虽然有所改进，但不是十分完美。
我在此代码的基础上作些优化，希望能给大家带来帮助！

Ps:1.前置条件：打开装配体并选择零件
2.使用方法：运行宏后输入名称
3.运行结果：同文件夹下生成新零件及附属工程图并保留原工程图

Dim swApp As Object
  Dim Part As Object
  Dim Error As Long
Dim Warning As Long
Dim mip As String
Dim Status As Boolean
Dim Newpath As String
Dim mipname As String
Dim vDepend() As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
      swComp.SetSuppression2 (3)
Set swSelModel = swComp.GetModelDoc2
Set swSelModelext = swSelModel.Extension

oldpathname = swComp.GetPathName

Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径
Debug.Print Path
ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀
Debug.Print ntype
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '旧文件名
Debug.Print oldfi
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
      mipname = InputBox("changename", "name", oldname) '新文件名

      mip = Path & mipname & ntype '新文件名带路径
      Debug.Print mip

If mip <> "" Then
      Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替换装配体中的原文件）
   Debug.Print Status
   '========================
   '更改工程图文件名
   Debug.Print Path
   tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
   Debug.Print tmpfi
   Do Until tmpfi =Null
      tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)
      Debug.Print tmpfiname
      tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"
      Debug.Print tmpoldname
      If tmpfiname = tmpoldname Then '查找同名工程图
      newdrwname = Path & mipname & ".SLDDRW"
      Debug.Print newdrwname
      olddrwname = Path & tmpfi
      filecopy olddrwname,newdrwname '复制工程图到新文件夹
      vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖
      Debug.Print vDepend(1)
      bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖

      Debug.Print bl
      Exit Do
   End If
tmpfi = Dir
Debug.Print tmpfi
Loop
End If
End Sub

ィ心兂鎅 · 发表于 2023-8-22 07:09:54

有版本限制吗？

cc851 · 发表于 2023-8-22 09:57:12

Solidworks自带命名，就是不能关联工程图一起改而已。从设计流程来说，改名在出图之前。其实就无所谓要不要插件了。

trongtrongtrong · 发表于 2023-8-22 10:14:22

凯元工具也可以批量改名

怕瓦落地2011 · 发表于 2023-8-22 21:14:08

trongtrongtrong 发表于 2023-8-22 10:14
" o1 m7 L5 O. S/ b% h9 N/ p, j: c凯元工具也可以批量改名

授人以鱼，不如授人以渔

shasu · 发表于 2023-8-24 16:19:18

谢谢版主分享

liyizheng5566 · 发表于 2023-11-8 16:07:45

复制粘贴过去代码错误

liyizheng5566 · 发表于 2023-11-8 16:08:14

显示代码错误一片红

lonelysnakejj · 发表于 2024-3-26 11:09:39

怎么拷贝好一些，复制都是乱码

Dustry · 发表于 2024-4-3 13:29:17

运行报错咋解决啊大佬

		自动登录	找回密码
密码			注册会员

重命名零件宏

评分

点评