重命名零件宏

怕瓦落地2011

Solidworks 雖功能強大，但有些地方做得不盡如人意，比如三維帶工程圖重命名，就顯得十分雞肋。論壇網(wǎng)友steve_suich發(fā)過一個改零件同時改工程圖的宏（http://www.ytsybjq.com/thread-1058539-1-2.html）,雖然有所改進(jìn)，但不是十分完美。
我在此代碼的基礎(chǔ)上作些優(yōu)化，希望能給大家?guī)韼椭?br /> ; Q0 ~6 i+ Y% f1 c/ D
4 D2 D8 R) `) I/ IPs:1.前置條件：打開裝配體并選擇零件
    2.使用方法：運行宏后輸入名稱
; o4 @% r4 s# w1 Q  C    3.運行結(jié)果：同文件夾下生成新零件及附屬工程圖并保留原工程圖

. |. M& Q) ]! j5 kDim swApp As Object
6 `& z* K; F6 g" r! ?: N! @6 M  Dim Part As Object
  }9 Q. c: S4 j% J! ?  Dim Error As Long
Dim Warning As Long
% G4 m$ c" O; }0 |& p$ o! gDim mip As String
" k! m/ y( b, x9 Q1 f9 N2 M. }Dim Status As Boolean
Dim Newpath As String
Dim mipname As String
7 ~& j. f5 j( A3 I% G; MDim vDepend() As String
    Sub main()
& ?9 _5 U4 V; b    Set swApp = Application.SldWorks
& A" J5 ~# Z2 n    Set Part = swApp.ActiveDoc
! v  R0 O$ }1 Q  P2 L    Set swSelMgr = Part.SelectionManager
    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
        swComp.SetSuppression2 (3)   
    Set swSelModel = swComp.GetModelDoc2
    Set swSelModelext = swSelModel.Extension

7 {5 s. `3 |- U    oldpathname = swComp.GetPathName
   
2 x$ a- `5 b( I# y! b( i    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路徑
6 J4 K1 ?; j8 \, n6 r8 ]    Debug.Print Path
; w' i, p0 o) S6 X) T0 J8 Z0 p" X    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    Debug.Print ntype
& d0 Y7 |) i# Y9 B/ s, ?    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '舊文件名
    Debug.Print oldfi
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
6 I- R6 ]) N6 ?8 w' [% ^" k         mipname = InputBox("changename", "name", oldname) '新文件名
         
         mip = Path & mipname & ntype '新文件名帶路徑
         Debug.Print mip
' |5 }  P1 e4 l  |: z
; r  o7 ~2 H% H: U7 f    If mip <> "" Then
         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
      Debug.Print Status
      '========================
6 h5 j  T) `7 w1 Q! `- X0 E      '更改工程圖文件名
. ^& I# R6 h1 }8 D3 H! y      Debug.Print Path
      tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
      Debug.Print tmpfi
      Do Until tmpfi =Null
* f9 e4 G/ l) X        tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)
        Debug.Print tmpfiname
9 [/ `2 C3 c* @( t        tmpoldname=mid(oldfi,1,instr(1,oldfi,".")-1) & ".SLDDRW"
        Debug.Print tmpoldname
        If tmpfiname = tmpoldname Then '查找同名工程圖
7 \! k- I3 M. G4 p        newdrwname = Path & mipname & ".SLDDRW"
        Debug.Print newdrwname
        olddrwname = Path & tmpfi
5 n% L4 }9 W8 C' T0 X         filecopy olddrwname,newdrwname '復(fù)制工程圖到新文件夾
        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
        Debug.Print vDepend(1)
        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴

; {" i, X9 ^0 V( c  M        Debug.Print bl
  h3 Q+ R1 l  N         Exit Do
       End If
. L3 _: f5 z# X6 l$ R- Y, [$ C( M  |    tmpfi = Dir
) u2 z# P" j- B: T0 w% ^$ W) ^) j# w    Debug.Print tmpfi
9 s! ?, s: \/ U) [+ A, r5 P+ j/ R    Loop
    End If
    End Sub





$ _& z" C1 p- e

ィ心兂鎅

有版本限制嗎？

cc851

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

trongtrongtrong

凱元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 發(fā)表于 2023-8-22 10:14
凱元工具也可以批量改名

授人以魚，不如授人以漁
2 ?+ j" o; S! N) r

shasu

謝謝版主 分享

liyizheng5566

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

liyizheng5566

顯示代碼錯誤 一片紅

lonelysnakejj

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

Dustry

運行報錯咋解決啊大佬