重命名零件宏

怕瓦落地2011

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

$ f" s  ]& H, o% d. [Ps:1.前置条件：打开装配体并选择零件
    2.使用方法：运行宏后输入名称
+ ^9 g( d# c3 {    3.运行结果：同文件夹下生成新零件及附属工程图并保留原工程图

Dim swApp As Object
% W, ~5 E: [$ M' D9 G7 j2 h  Dim Part As Object
7 B0 F$ d# w, b, i1 u* Q" W  Dim Error As Long
Dim Warning As Long
Dim mip As String
3 t* ?' V! q# XDim Status As Boolean
1 s, R) W$ o4 SDim Newpath As String
Dim mipname As String
Dim vDepend() As String
) i" _, L9 a8 g' f$ K+ w. m7 M    Sub main()
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
) C& Q; n6 x( B. _0 h: [+ _+ N- {9 M    Set swSelMgr = Part.SelectionManager
: }. S; ]5 `" z" \( p1 I* V    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
        swComp.SetSuppression2 (3)   
9 N6 |& n4 w. b% U" ]+ _    Set swSelModel = swComp.GetModelDoc2
* A0 I$ F& I( I) d; g# e    Set swSelModelext = swSelModel.Extension

    oldpathname = swComp.GetPathName
   
+ \2 X( o* [) X7 K9 @7 Y    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径
! o$ M; ^) ^0 R- c4 L    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) '新文件名
$ o. k- q! v8 x5 \5 q, b         
* {0 D3 v6 L) M( M+ Y         mip = Path & mipname & ntype '新文件名带路径
         Debug.Print mip

7 J: s: I* g3 s) Z" @) |. j    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
* y& `- q/ H- R- V- D: m        If tmpfiname = tmpoldname Then '查找同名工程图
/ I5 T6 e" n7 \4 e7 M$ b, \        newdrwname = Path & mipname & ".SLDDRW"
4 H) N" _6 C9 J; w        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) '替换工程图依赖
7 L+ t, ^" A  y$ R
% C) ]8 H3 w$ p        Debug.Print bl
0 l0 H) o! t1 _3 b2 r         Exit Do
       End If
" Y- Z9 M% N: C/ a1 O    tmpfi = Dir
    Debug.Print tmpfi
    Loop
    End If
    End Sub
+ A# g* M$ V, I7 i6 U
/ |1 i+ z$ ~# c& P6 N6 [6 b* d9 U
% m1 l4 e/ @8 }6 m! W

% z1 [0 C- u" P

ィ心兂鎅

有版本限制吗？

cc851

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

trongtrongtrong

凯元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 发表于 2023-8-22 10:14
1 F+ }. }1 P2 u凯元工具也可以批量改名

授人以鱼，不如授人以渔
0 e7 g* H% u8 T7 z2 Z

shasu

谢谢版主 分享

liyizheng5566

复制粘贴过去代码错误

liyizheng5566

显示代码错误 一片红

lonelysnakejj

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

Dustry

运行报错咋解决啊大佬
( e2 i, I' [. i- O! b( I3 a