重命名零件宏

怕瓦落地2011

Solidworks 雖功能強(qiáng)大，但有些地方做得不盡如人意，比如三維帶工程圖重命名，就顯得十分雞肋。論壇網(wǎng)友steve_suich發(fā)過一個改零件同時改工程圖的宏（http://www.hrhome.com.cn/thread-1058539-1-2.html）,雖然有所改進(jìn)，但不是十分完美。
我在此代碼的基礎(chǔ)上作些優(yōu)化，希望能給大家?guī)韼椭?font class="jammer">1 a0 |* x. V; b& y  ^3 d

4 V) h5 @, k: L6 R( t; rPs:1.前置條件：打開裝配體并選擇零件
    2.使用方法：運(yùn)行宏后輸入名稱
5 |) G8 ?2 V9 G7 w. I    3.運(yùn)行結(jié)果：同文件夾下生成新零件及附屬工程圖并保留原工程圖

Dim swApp As Object
  Dim Part As Object
  Dim Error As Long
# v0 E" P# e" b( gDim Warning As Long
Dim mip As String
Dim Status As Boolean
- j, D  w. y' jDim Newpath As String
/ w  j! p- n3 g: @' |0 uDim mipname As String
+ F7 g1 X2 |3 Y& N$ ^2 HDim vDepend() As String
/ ^% }% W7 }" N) O7 |. i    Sub main()
6 A- K' {- G7 o) M5 V    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
# ]5 v1 d% G: {    Set swSelMgr = Part.SelectionManager
" S3 H3 U. K# P0 \6 {    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
        swComp.SetSuppression2 (3)   
: S2 m3 L+ M/ P2 W5 \    Set swSelModel = swComp.GetModelDoc2
    Set swSelModelext = swSelModel.Extension

    oldpathname = swComp.GetPathName
0 }3 l0 @- K4 B- v! H' Q: y   
    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路徑
    Debug.Print Path
8 f, T1 d; n3 M9 M0 i8 |0 f) G- A    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
) X1 s: a8 d" H2 i; g( _; A4 c    Debug.Print ntype
3 l7 X1 p0 [5 n1 e    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '舊文件名
) N# @3 i8 P0 c) {+ Z, c2 @2 ?    Debug.Print oldfi
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
% {4 Z3 U* A/ P! [+ y8 h4 V         mipname = InputBox("changename", "name", oldname) '新文件名
" m  \* {  J; \5 v         
' b; S1 ]; V) M         mip = Path & mipname & ntype '新文件名帶路徑
# o) X& k- L+ F, X. I* `         Debug.Print mip

3 x( c; h4 s. Z/ [# t. Z5 r( D. d    If mip <> "" Then
6 w- }  i+ v7 a* u         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
1 I! T3 U# B3 o      Debug.Print Status
- {' K4 V  L3 y3 \4 _. P9 U      '========================
: F- |9 b! c- Q- k4 a) E      '更改工程圖文件名
7 j6 k  H+ g& d# l      Debug.Print Path
4 S7 D  q0 [# w+ K$ O8 e      tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
" F$ P; D) Q8 I( X6 o+ Z$ ]; T      Debug.Print tmpfi
& r; r0 [# G& j% W- @      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 '查找同名工程圖
3 h4 w1 y7 G: q4 g1 e        newdrwname = Path & mipname & ".SLDDRW"
% u0 I3 i1 T& R) ~" y        Debug.Print newdrwname
* H( s; p7 ^( J- R( k        olddrwname = Path & tmpfi
         filecopy olddrwname,newdrwname '復(fù)制工程圖到新文件夾
        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
        Debug.Print vDepend(1)
& B4 s2 c' N: M- L. y8 d        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
$ N, M: E& a/ m9 C6 G/ \' b1 \
. L8 b% _5 F, W7 M        Debug.Print bl
4 i+ B7 O& j; |: C/ i: e         Exit Do
       End If
    tmpfi = Dir
    Debug.Print tmpfi
3 ?6 B# v1 \& t  g    Loop
    End If
, f% d( e5 m5 ~    End Sub
4 ]2 ~( m3 y/ {+ X5 [$ k


( K: V4 s9 g- i
5 Q4 ^& [* X* c

ィ心兂鎅

有版本限制嗎？

cc851

Solidworks自帶命名，就是不能關(guān)聯(lián)工程圖一起改而已。從設(shè)計(jì)流程來說，改名在出圖之前。其實(shí)就無所謂要不要插件了。

trongtrongtrong

凱元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 發(fā)表于 2023-8-22 10:14
& v+ S( H- p9 V: u1 }凱元工具也可以批量改名

8 s# [$ S/ k4 ]* G: j授人以魚，不如授人以漁
0 y7 b: }1 a9 P2 X0 C0 y  c/ j

shasu

謝謝版主 分享

liyizheng5566

復(fù)制粘貼過去代碼錯誤

liyizheng5566

顯示代碼錯誤 一片紅

lonelysnakejj

怎么拷貝好一些，復(fù)制都是亂碼

Dustry

運(yùn)行報錯咋解決啊大佬
5 m1 r# \# a5 l' c# \% W  C1 k