重命名零件宏

怕瓦落地2011

Solidworks 雖功能強大，但有些地方做得不盡如人意,，比如三維帶工程圖重命名，就顯得十分雞肋,。論壇網(wǎng)友steve_suich發(fā)過一個改零件同時改工程圖的宏（http://giwivy.com.cn/thread-1058539-1-2.html）,雖然有所改進,，但不是十分完美。
+ y, X! Q7 w6 {我在此代碼的基礎(chǔ)上作些優(yōu)化,，希望能給大家?guī)�來幫助�?font class="jammer">! A1 _+ ~4 F! s' w

/ X9 S4 ^- B/ n8 ?$ X) L: RPs:1.前置條件：打開裝配體并選擇零件
( ]! l3 _1 `9 J3 ~. y    2.使用方法：運行宏后輸入名稱
+ g4 f5 O! n' E) K5 i# c0 ^1 F    3.運行結(jié)果：同文件夾下生成新零件及附屬工程圖并保留原工程圖

& R" P+ @& ]) N' d8 b* W# bDim swApp As Object
  Dim Part As Object
  Dim Error As Long
8 q) ~- ]0 ~1 y8 h, {  B9 ODim Warning As Long
Dim mip As String
Dim Status As Boolean
0 M5 V  O8 j  q& Q6 o9 HDim Newpath As String
5 M3 m. ]8 k- C4 n' E4 Q) ]) Z5 N* B) BDim mipname As String
Dim vDepend() As String
    Sub main()
! v$ \+ l) N9 U: h" ?8 S    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
+ {$ ~" \; T6 T    Set swSelMgr = Part.SelectionManager
9 Y2 |, B9 B5 R, S5 P    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
        swComp.SetSuppression2 (3)   
    Set swSelModel = swComp.GetModelDoc2
3 \3 l; s8 T2 Q7 S( v& g    Set swSelModelext = swSelModel.Extension
" P' }& T; o- @* s, e; Y8 U
    oldpathname = swComp.GetPathName
) }6 g; f7 r5 T6 @   
* ?7 [0 D$ q1 i2 G( U. u1 ]    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路徑
    Debug.Print Path
    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    Debug.Print ntype
1 n2 V) g5 `7 `. q0 k! C& R0 W    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '舊文件名
    Debug.Print oldfi
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
, d- O" Z) w5 N* j         mipname = InputBox("changename", "name", oldname) '新文件名
" [  W. ?7 {5 o9 g% A9 n         
$ g& t1 i: A; m         mip = Path & mipname & ntype '新文件名帶路徑
         Debug.Print mip
8 M; ^7 w% \( x3 s
    If mip <> "" Then
+ @6 v- n$ M  D# O  H2 ^         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
1 C# A9 Y1 k3 L) O& d( |6 z; o      Debug.Print Status
      '========================
      '更改工程圖文件名
" K: ~( a" Q0 z# }/ t+ V0 c$ Q      Debug.Print Path
% `+ u2 K; f7 n6 j  p) r% h, m! Y3 |      tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
      Debug.Print tmpfi
      Do Until tmpfi =Null
        tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)
        Debug.Print tmpfiname
, {6 O# z/ D  }4 D! W% [: U        tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"
: f! Z9 Z3 I8 v! j+ B  i7 B" D        Debug.Print tmpoldname
/ F+ {9 d# Y: e3 G4 \+ m1 \0 T/ B. ^        If tmpfiname = tmpoldname Then '查找同名工程圖
        newdrwname = Path & mipname & ".SLDDRW"
        Debug.Print newdrwname
( Z  e+ n1 m4 ~1 s: h' _        olddrwname = Path & tmpfi
         filecopy olddrwname,newdrwname '復(fù)制工程圖到新文件夾
        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
0 |- S6 U! y0 b  L        Debug.Print vDepend(1)
        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴

6 f0 M) K5 F; ?5 S' |; C% m        Debug.Print bl
         Exit Do
       End If
1 A% t9 y' [; z. v8 m    tmpfi = Dir
8 z; R6 h' ~* c$ q" S    Debug.Print tmpfi
    Loop
    End If
' d, I9 b1 A7 }) i7 C% j    End Sub

& l. e- D5 K7 B" P. c; y



! Q) {0 B. w. X! w

ィ心兂鎅

有版本限制嗎,？

cc851

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

trongtrongtrong

凱元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 發(fā)表于 2023-8-22 10:14
; K5 K  Z5 y/ V8 H; B凱元工具也可以批量改名

. z) g1 @, W' \3 l) ]* u6 M授人以魚，不如授人以漁
0 [* {% ]2 z. \: f$ F. d: ?  _

shasu

謝謝版主 分享

liyizheng5566

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

liyizheng5566

顯示代碼錯誤 一片紅

lonelysnakejj

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

Dustry

運行報錯咋解決啊大佬