重命名零件宏

怕瓦落地2011

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

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

Dim swApp As Object
g3 g2 \" {* r* x6 p$ yDim Part As Object
T4 r3 k p. G- r1 tDim Error As Long
6 `6 W+ Y: A1 X! z! a! u8 ]Dim Warning As Long
Dim mip As String
Dim Status As Boolean
Dim Newpath As String
Dim mipname As String
Dim vDepend() As String
9 e; ?( H; g5 _+ tSub main()
Set swApp = Application.SldWorks
3 L: C7 R i8 N/ t& O* USet Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
9 U u6 Q. {% ~' ^swComp.SetSuppression2 (3)
% v9 A/ `' x c, U! x4 KSet swSelModel = swComp.GetModelDoc2
+ o/ R7 @7 X6 |+ N# k& P( d3 t- ZSet swSelModelext = swSelModel.Extension

oldpathname = swComp.GetPathName

Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径
Debug.Print Path
/ b3 S2 Y7 e" ]' Zntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀
Debug.Print ntype
' l0 j) R' Y/ }' f# X- v1 {oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '旧文件名
Debug.Print oldfi
+ e7 f3 t7 w; }/ I) ?# [/ c( o# K1 Soldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
9 c. J3 u& P- d9 z: Z# i! Emipname = InputBox("changename", "name", oldname) '新文件名

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

' T8 m, r7 p% K& C B# }+ \8 bIf mip <> "" Then
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替换装配体中的原文件）
Debug.Print Status
'========================
'更改工程图文件名
, H8 B0 H7 H- |& b; RDebug.Print Path
tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
Debug.Print tmpfi
Do Until tmpfi =Null
tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)
F; l7 \+ V' R9 O; T \Debug.Print tmpfiname
tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"
Debug.Print tmpoldname
If tmpfiname = tmpoldname Then '查找同名工程图
: p) R9 u5 o0 d" g8 B* P Ynewdrwname = Path & mipname & ".SLDDRW"
4 M/ J! E, j5 W2 R0 h7 sDebug.Print newdrwname
olddrwname = Path & tmpfi
filecopy olddrwname,newdrwname '复制工程图到新文件夹
# o4 x1 {5 M; b0 W! F6 N& VvDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖
, |' m$ _7 b/ z: e0 l- DDebug.Print vDepend(1)
' ~' C2 i& U5 A0 qbl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖
* ]3 s4 c5 K" }, S( `" S
Debug.Print bl
6 q4 \$ Q! a2 h5 fExit Do
: V. j3 \) D4 K! S8 ]7 E7 G1 Q4 XEnd If
tmpfi = Dir
Debug.Print tmpfi
Loop
& J* h9 i& p+ V- |9 CEnd If
: E4 ]0 m+ x8 h+ T& W5 ?End Sub


. O1 n2 a# F: R/ G! n
# p. d" Y5 b, G# ^6 v$ {7 ~

' t; \, y7 f6 D* \4 j, t* X

ィ心兂鎅

有版本限制吗？

cc851

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

trongtrongtrong

凯元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 发表于 2023-8-22 10:14
凯元工具也可以批量改名

0 G9 E) c, O0 I5 ?, @, [7 {授人以鱼，不如授人以渔

shasu

谢谢版主 分享

liyizheng5566

复制粘贴过去代码错误

liyizheng5566

显示代码错误 一片红

lonelysnakejj

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

Dustry

运行报错咋解决啊大佬