机械必威体育网址

标题: 重命名零件宏 [打印本页]
作者: 怕瓦落地2011    时间: 2023-8-21 21:07
标题: 重命名零件宏
Solidworks 虽功能强大，但有些地方做得不尽如人意，比如三维带工程图重命名，就显得十分鸡肋。必威APP精装版下载网友steve_suich发过一个改零件同时改工程图的宏（//www.szfco.com/thread-1058539-1-2.html）,虽然有所改进，但不是十分完美。
5 m' s: [+ [( M' w: n我在此代码的基础上作些优化，希望能给大家带来帮助！7 y# C' U' ~9 ?" K  B5 u- V
" x7 D- \7 j8 H
Ps:1.前置条件：打开装配体并选择零件; D2 N8 T! f* S; |1 o
    2.使用方法：运行宏后输入名称
2 Z, p. u; g9 K7 V  {2 J, J    3.运行结果：同文件夹下生成新零件及附属工程图并保留原工程图9 B; P1 g4 d8 \6 N* b! i* ~- _6 B$ U
! V2 t- V; ?% C. V+ |! `) E
Dim swApp As Object' N. K1 L" `4 r
  Dim Part As Object. G, ?4 G0 l" q: N
  Dim Error As Long1 L: o. A' \9 S6 x! u
Dim Warning As Long! m& R( l9 F0 `' f1 D& v
Dim mip As String& T, j, C9 S6 {0 z: g
Dim Status As Boolean! Q! e+ Z0 L; a1 i
Dim Newpath As String7 N3 ?7 p' H" C- p5 {
Dim mipname As String( l6 v6 K/ ]% h
Dim vDepend() As String
" g. i: j; m& e6 l9 q    Sub main()
2 u* C, r7 P# k9 H/ w5 n; U    Set swApp = Application.SldWorks. b! a: ?; y+ P: V: I
    Set Part = swApp.ActiveDoc
9 Z% ~0 A7 d, E$ j    Set swSelMgr = Part.SelectionManager
9 Z; O8 I8 q+ U- n7 Y0 k9 K( H7 z$ w    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
) `/ H/ ]& \5 L! q+ [, \8 ~        swComp.SetSuppression2 (3)    & u$ g+ ^% Y5 P' E5 X; o- `# I
    Set swSelModel = swComp.GetModelDoc2
6 _: b" q& v- P, b- X    Set swSelModelext = swSelModel.Extension
5 Q2 w6 t1 M' ~# C6 t& R' b. p+ T3 I6 z' K% `( r0 U4 A" Z3 w
    oldpathname = swComp.GetPathName9 G( {( i5 z! s
    ; _1 W2 C1 a# v
    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径: i+ Z7 F: h" D8 \( P, g! n- F
    Debug.Print Path: R* m& ?& I# J3 |- F* i' w
    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀2 {1 ~$ C7 H/ h+ }# Z8 J
    Debug.Print ntype
- [. r! f) U+ Z' l    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '旧文件名
! N, w$ U/ d1 e, K/ t3 D    Debug.Print oldfi6 g7 Z' _  W3 o
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)5 o6 R( X* o5 g
         mipname = InputBox("changename", "name", oldname) '新文件名
+ @+ H  O: m* K9 u/ D/ [         
2 A$ y$ ^1 j- l3 }; E1 R         mip = Path & mipname & ntype '新文件名带路径6 U$ v( u+ ~8 A0 b& T: Z' m
         Debug.Print mip
0 d$ X8 W  l( H4 G) S3 f3 p" K) \1 X0 C! A
    If mip <> "" Then# L$ x, W* d: H( o. _
         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替换装配体中的原文件）
) k1 L' F# I' L- a. P* s( l' p7 |+ r$ S      Debug.Print Status
0 l1 c$ [0 O+ D5 h7 Q      '========================
7 r0 @% c$ f7 s$ h8 p2 Y4 @      '更改工程图文件名
5 r- \0 l: I9 q7 t# w      Debug.Print Path0 ]! w' A9 l" ^, @% h+ W
      tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
7 n1 Z' I" o" |& I2 V+ E      Debug.Print tmpfi
  t& N3 ]7 @; \: F" t8 l& q      Do Until tmpfi =Null 7 h* J5 h# s. f5 l# q
        tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)+ u% l: k6 z0 ]
        Debug.Print tmpfiname
' H2 ~2 ]; X6 L  y        tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"8 a+ I0 t, T, ^2 ?
        Debug.Print tmpoldname* E6 T( o9 L2 T" F2 f, \! Y: s
        If tmpfiname = tmpoldname Then '查找同名工程图) ?$ A. @$ z% v5 }% p
        newdrwname = Path & mipname & ".SLDDRW"% Z1 n2 k9 [; D# K( r; W" C
        Debug.Print newdrwname+ g/ m( u& U8 r
        olddrwname = Path & tmpfi7 J" S& x. y9 [2 X: r
         filecopy olddrwname,newdrwname '复制工程图到新文件夹
1 [7 x; y2 J6 v9 g1 l$ q        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖
) r. F* e9 H. W3 K) ~        Debug.Print vDepend(1)
1 ~% {! V/ D6 K; R" X        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖
' J' S+ s6 r: G; C' H% r$ l+ l" [  b
/ ~! ~0 `' J0 m. p2 B8 N$ R        Debug.Print bl. X* t% z: O& ]0 b3 \! Q( u
         Exit Do3 b' `; l' m' R9 O3 H; R
       End If
( n/ O0 t& b* X! @    tmpfi = Dir
: v+ N, u6 k2 @! ]! r3 S' c    Debug.Print tmpfi" l" J& t( y7 {' H; A; s/ ^
    Loop
6 N9 t  x4 e+ g" L+ f. @& @* j    End If  X% N' _8 ^  O# ]" |9 v% X
    End Sub
% H) ~% t; w. v. l! S! t# d3 Q* r+ g. H# f. u( g9 X5 j4 s
4 e3 [/ C8 _: e2 X! ?, V9 ~# O

; o2 C5 b3 x; x4 N( \3 {, o4 G; A# j# \4 ]: B
+ T% k2 ]4 h6 g/ Z% B
作者: ィ心兂鎅    时间: 2023-8-22 07:09
有版本限制吗？
作者: cc851    时间: 2023-8-22 09:57
Solidworks自带命名，就是不能关联工程图一起改而已。从设计流程来说，改名在出图之前。其实就无所谓要不要插件了。
作者: trongtrongtrong    时间: 2023-8-22 10:14
凯元工具也可以批量改名
作者: 怕瓦落地2011    时间: 2023-8-22 21:14
trongtrongtrong 发表于 2023-8-22 10:14& f7 |5 x- C  w  V7 N* F; G
凯元工具也可以批量改名

8 Z9 D! |1 @% O& C6 \授人以鱼，不如授人以渔
% ]% s) s: Q& i6 a
作者: shasu    时间: 2023-8-24 16:19
谢谢版主 分享
作者: liyizheng5566    时间: 2023-11-8 16:07
复制粘贴过去代码错误
作者: liyizheng5566    时间: 2023-11-8 16:08
显示代码错误 一片红
作者: lonelysnakejj    时间: 2024-3-26 11:09
怎么拷贝好一些，复制都是乱码
作者: Dustry    时间: 2024-4-3 13:29
运行报错咋解决啊大佬# E! A% R0 p# G
作者: Dustry    时间: 2024-4-3 14:26
Dustry 发表于 2024-4-3 13:29
+ ^% p# }- e) M运行报错咋解决啊大佬
( l' c2 c  k" S  }
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替换装配体中的原文件）
( u  e. t7 g$ l. v6 _  _对象不支持这个属性或方法（错误 438）, E) c5 _, }- G  C! G( h
作者: peiyj    时间: 2024-4-4 12:44
运行出错! @& `* T2 u. O) g7 P7 K
作者: 头铁杨    时间: 2024-5-20 14:38
好用，如果再加个删除原图纸就更完美了
作者: 落叶luoyi    时间: 2024-5-23 13:01
提示编译错误：没有适当的对象，方法无效
- S" ?4 o7 o4 o( z0 y, U" K) i- `大佬，这个怎么修改啊
作者: cot    时间: 2024-6-2 21:04
感谢
作者: 小菜鸡123    时间: 2024-9-3 10:13
怕瓦落地2011 发表于 2023-8-22 21:14' P8 n' d2 @( A) C! x+ C: @
授人以鱼，不如授人以渔
8 Y$ O5 v4 d2 W! s
为什么复制了代码，点击了启动，没有反应，重新启动也没有反应，代码里面红色的，这个有关系吗？



欢迎光临 机械必威体育网址 (//www.szfco.com/) Powered by Discuz! X3.4