机械必威体育网址

 找回密码
 注册会员

QQ登录

只需一步,快速开始

搜索
查看: 16703|回复: 15
打印 上一主题 下一主题

重命名零件宏

[复制链接]
跳转到指定楼层
1#
发表于 2023-8-21 21:07:44 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Solidworks 虽功能强大,但有些地方做得不尽如人意,比如三维带工程图重命名,就显得十分鸡肋。必威APP精装版下载网友steve_suich发过一个改零件同时改工程图的宏(//www.szfco.com/thread-1058539-1-2.html),虽然有所改进,但不是十分完美。
4 N- K' Q% V  {" R7 ^我在此代码的基础上作些优化,希望能给大家带来帮助!
. C0 d) J% @" u% I
' N2 ^8 V/ h0 ?, @Ps:1.前置条件:打开装配体并选择零件: J/ a$ E* v  U0 Y1 i( ]
    2.使用方法:运行宏后输入名称
  Q+ ~) o5 q5 R' y    3.运行结果:同文件夹下生成新零件及附属工程图并保留原工程图+ X% `" B. l0 A! K' W4 J

6 F1 J6 m+ u! j, ]* T4 n2 bDim swApp As Object6 _, u9 k) c# h8 t3 c% Q3 x4 c
  Dim Part As Object6 E) Y% s9 B) E
  Dim Error As Long
# Z3 X( T: p9 J- R! ^( Z' ~. hDim Warning As Long8 d2 ]* |4 ?' p# P1 K0 K6 s* G0 y, K3 m
Dim mip As String
0 Z, A! U' Y$ X: e$ t. v7 q6 ^Dim Status As Boolean4 m6 Q  S9 G. N: h
Dim Newpath As String
+ v+ @' Y* b( l* z# }' YDim mipname As String
' K/ Q; E' H  m) MDim vDepend() As String
. _$ Z2 {: [$ ^( |! j    Sub main()
: Y/ b8 w. i4 I    Set swApp = Application.SldWorks
- m+ N3 M# i$ N) }- Z/ `' r    Set Part = swApp.ActiveDoc
5 p% J  D1 P! s1 b$ V, J" `    Set swSelMgr = Part.SelectionManager% W7 u/ d) R2 W! U  x7 L
    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0)
- x% f# `) F& y2 N  W        swComp.SetSuppression2 (3)   
; M0 _3 m" v7 E3 A' d* j/ a* F2 x    Set swSelModel = swComp.GetModelDoc2, L2 d$ J0 H' T. |# P4 @# |  h
    Set swSelModelext = swSelModel.Extension
% Q, j+ s' k9 }0 o. ]8 Q5 s0 o
3 Y* x& a6 Z; P5 t) R+ h; s' {    oldpathname = swComp.GetPathName
. h  g4 K. e) @- q% |7 a8 ]   
0 Q$ S3 q- g; f7 U2 e  r# E; y    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径
6 D! n7 {: W: K0 d8 O$ \2 |; R    Debug.Print Path
& O9 ~* j* H8 I+ K    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀$ e& @3 P5 o1 \* X% Q
    Debug.Print ntype
3 M$ J) ~5 ?( u) [( x/ e- h6 m    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '旧文件名
, r  m* p+ m7 j8 M& `0 n' D; Y    Debug.Print oldfi8 ?: c& O; j9 s3 w0 d; C$ n9 {
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1); g# m' x( l0 j  X
         mipname = InputBox("changename", "name", oldname) '新文件名
0 }; W; r8 h' e( _4 Q$ a         ( I$ R8 V$ v2 V2 X9 d$ k6 u
         mip = Path & mipname & ntype '新文件名带路径6 I; _& c8 j+ t9 n
         Debug.Print mip1 C/ ?. @. B7 Q+ N5 F

, f7 t- T" A2 ?% f    If mip <> "" Then
. r% Q3 x; i& ]1 [         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名(替换装配体中的原文件)/ ?/ z) X( H3 r
      Debug.Print Status2 q9 J8 n7 _+ d, h, H
      '========================
: j' P2 c1 U/ D0 m2 b) w      '更改工程图文件名; V+ Y3 T8 R7 ^3 b0 f
      Debug.Print Path- {$ t$ g( M( ^) {
      tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
5 }9 x. G7 l. B      Debug.Print tmpfi. t" \5 U6 z' Q4 C" R$ v* {9 `
      Do Until tmpfi =Null
- f: a1 ~+ `" R        tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)* u$ l7 }% u* J3 }* I6 L
        Debug.Print tmpfiname
$ q- s- ?; i. R# c        tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"
+ R  M, E7 z, H) R/ y7 G        Debug.Print tmpoldname
" \( e( {& n6 A" B5 |/ N        If tmpfiname = tmpoldname Then '查找同名工程图
( W# t) r( ]! U8 _+ h; m1 j        newdrwname = Path & mipname & ".SLDDRW"2 y6 }6 ?  g! T; ]( J
        Debug.Print newdrwname
5 O3 _) F8 f# d4 T; d! p" L        olddrwname = Path & tmpfi9 x0 p2 c& b% U0 \% v% C
         filecopy olddrwname,newdrwname '复制工程图到新文件夹- v! Q: }; a7 ^: D2 H
        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖& E; k2 {) m% h+ R' X
        Debug.Print vDepend(1)
3 A; ?/ o7 F7 J! R0 g/ n5 q        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖
1 s6 T% W1 F; e  _1 |9 K, z7 H
# i/ H: M+ k( z        Debug.Print bl6 P3 d3 q' E0 L6 j! r* \
         Exit Do
- U9 _7 [+ d! P- X! F4 V- ~; `       End If
2 |$ g( `$ H  o' i! n9 K  e    tmpfi = Dir6 o5 y% B5 u8 K0 ~
    Debug.Print tmpfi- ?- }( [) A' M; A$ Z, u! l# v. L
    Loop
4 x( C5 t/ m% N. \    End If7 c$ p- D* r  s5 }7 R  g3 q4 ^9 Y" B
    End Sub# a' v5 W  e# i

) n3 v3 o+ M5 X( e# ^& H
( X* X1 S, W7 L9 S9 H
* i: Z" m' y1 m6 w8 q' t* x2 N( f8 G7 [, M; |0 [
3 Y: n5 O" O4 g, S- w" [8 I

评分

参与人数 1威望 +1 收起 理由
陈进一 + 1

查看全部评分

回复

使用道具 举报

2#
发表于 2023-8-22 07:09:54 | 只看该作者
有版本限制吗?
回复 支持 反对

使用道具 举报

3#
发表于 2023-8-22 09:57:12 | 只看该作者
Solidworks自带命名,就是不能关联工程图一起改而已。从设计流程来说,改名在出图之前。其实就无所谓要不要插件了。
回复 支持 反对

使用道具 举报

4#
发表于 2023-8-22 10:14:22 | 只看该作者
凯元工具也可以批量改名

点评

授人以鱼,不如授人以渔  详情 回复 发表于 2023-8-22 21:14
回复 支持 反对

使用道具 举报

5#
 楼主| 发表于 2023-8-22 21:14:08 | 只看该作者
trongtrongtrong 发表于 2023-8-22 10:14$ L/ T3 f# {( K8 S  y* h
凯元工具也可以批量改名
  R) B! `' w; [
授人以鱼,不如授人以渔4 ]5 c3 u( S. [0 a
回复 支持 1 反对 0

使用道具 举报

6#
发表于 2023-8-24 16:19:18 | 只看该作者
谢谢版主 分享
回复 支持 反对

使用道具 举报

7#
发表于 2023-11-8 16:07:45 | 只看该作者
复制粘贴过去代码错误
回复 支持 反对

使用道具 举报

8#
发表于 2023-11-8 16:08:14 | 只看该作者
显示代码错误 一片红
回复 支持 反对

使用道具 举报

9#
发表于 2024-3-26 11:09:39 | 只看该作者
怎么拷贝好一些,复制都是乱码
回复 支持 反对

使用道具 举报

10#
发表于 2024-4-3 13:29:17 | 只看该作者
运行报错咋解决啊大佬# c9 O3 y, P/ b  {" @
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册会员

本版积分规则

小黑屋|手机版|Archiver|机械必威体育网址 ( 京ICP备10217105号-1,京ICP证050210号,浙公网安备33038202004372号 )

GMT+8, 2024-11-23 19:48 , Processed in 0.089101 second(s), 15 queries , Gzip On.

Powered by Discuz! X3.4 Licensed

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表