重命名零件宏

怕瓦落地2011

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

Ps:1.前置條件：打開裝配體并選擇零件
( [! e' n( b3 N$ L    2.使用方法：運行宏后輸入名稱
! i3 y" A# c) [    3.運行結果：同文件夾下生成新零件及附屬工程圖并保留原工程圖
, p2 X1 @6 J! t( F' j" j8 [& {# A
4 f5 @2 W5 Q& pDim swApp As Object
% h! X1 f; n9 N* y3 |' n  Dim Part As Object
  Dim Error As Long
: v) {' x9 z9 G& f7 v7 p/ d9 ]) oDim Warning As Long
, {( S+ G3 Y  F2 p+ y" _8 I+ wDim mip As String
* K- Q$ P0 L' U/ d6 R& Z' N7 Q0 \Dim Status As Boolean
- @5 v) {7 r2 v2 E7 d! U' iDim Newpath As String
Dim mipname As String
( A4 [9 t5 {  G0 @Dim vDepend() As String
    Sub main()
% a+ _. I6 Q4 M9 r    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
) i. t; C1 r! v- G. i2 Z% T4 c( w$ f    Set swSelMgr = Part.SelectionManager
    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
        swComp.SetSuppression2 (3)   
    Set swSelModel = swComp.GetModelDoc2
) P" k2 S% q: B: Z/ c    Set swSelModelext = swSelModel.Extension
) c% O, C" D# A) n7 g% }
    oldpathname = swComp.GetPathName
   
! d- T5 Q9 Q& \; a0 ?2 t: z    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路徑
    Debug.Print Path
5 r* Z# S7 A! I( e  \    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
- g9 K* g' J; |! [+ A    Debug.Print ntype
    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '舊文件名
    Debug.Print oldfi
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
7 D5 k" G5 Y/ }2 P/ F0 T$ {2 P         mipname = InputBox("changename", "name", oldname) '新文件名
         
  z8 ^0 f) V0 ~; `) k! Y         mip = Path & mipname & ntype '新文件名帶路徑
         Debug.Print mip
; V* A. {6 Q1 p+ i# G. w
* T& s8 l$ O: v    If mip <> "" Then
  f( d: k; @8 ]3 c  \2 `         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
- h( P+ g# u+ F8 ~+ ?2 X. y0 \      Debug.Print Status
      '========================
  ^2 b" r* n9 f# u, n' D      '更改工程圖文件名
9 G+ X, Y- c3 G  u' W) r- c3 D/ V      Debug.Print Path
/ ]/ N( x5 }8 E. ?" B6 W      tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
. [' {2 J* \* x# {; h, c0 W# p      Debug.Print tmpfi
      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 '查找同名工程圖
        newdrwname = Path & mipname & ".SLDDRW"
: m  Q6 P7 `( P4 V* F! P; _3 B/ |        Debug.Print newdrwname
        olddrwname = Path & tmpfi
5 n" Z) v9 A2 [+ D9 K  e2 {         filecopy olddrwname,newdrwname '復制工程圖到新文件夾
7 m5 V! _+ W+ F1 G0 `        vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
        Debug.Print vDepend(1)
        bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴

6 f2 q6 ~6 q9 l! |/ Q        Debug.Print bl
         Exit Do
5 n0 ?& V# a2 z9 B0 }/ ?       End If
) `+ V, Z9 ^2 N    tmpfi = Dir
9 K7 O' R5 C1 c- Y    Debug.Print tmpfi
/ e5 l0 O: M; L2 d    Loop
    End If
$ z5 }0 i/ J( z0 `6 V    End Sub



0 j, [. r; }! p! w
/ ^" A8 s2 @7 @/ j( t

ィ心兂鎅

有版本限制嗎,？

cc851

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

trongtrongtrong

凱元工具也可以批量改名

怕瓦落地2011

trongtrongtrong 發(fā)表于 2023-8-22 10:14
' u0 f" b, z: t) c; S* E, j8 V! ~* `凱元工具也可以批量改名

授人以魚,，不如授人以漁
  |/ r  y4 M8 u( K

shasu

謝謝版主 分享

liyizheng5566

復制粘貼過去代碼錯誤

liyizheng5566

顯示代碼錯誤 一片紅

lonelysnakejj

怎么拷貝好一些，復制都是亂碼

Dustry

運行報錯咋解決啊大佬
- R" E- q- |# r7 H! O) @* F  j. R