機(jī)械社區(qū)

標(biāo)題: 重命名零件宏 [打印本頁(yè)]

作者: 怕瓦落地2011 時(shí)間: 2023-8-21 21:07
標(biāo)題: 重命名零件宏
Solidworks 雖功能強(qiáng)大，但有些地方做得不盡如人意，比如三維帶工程圖重命名，就顯得十分雞肋。論壇網(wǎng)友steve_suich發(fā)過(guò)一個(gè)改零件同時(shí)改工程圖的宏（http://www.mg7058.com/thread-1058539-1-2.html）,雖然有所改進(jìn)，但不是十分完美。
我在此代碼的基礎(chǔ)上作些優(yōu)化，希望能給大家?guī)?lái)幫助！

Ps:1.前置條件：打開裝配體并選擇零件
2.使用方法：運(yùn)行宏后輸入名稱
3.運(yùn)行結(jié)果：同文件夾下生成新零件及附屬工程圖并保留原工程圖

Dim swApp As Object
  Dim Part As Object
  Dim Error As Long
Dim Warning As Long
Dim mip As String
Dim Status As Boolean
Dim Newpath As String
Dim mipname As String
Dim vDepend() As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0）
      swComp.SetSuppression2 (3)
Set swSelModel = swComp.GetModelDoc2
Set swSelModelext = swSelModel.Extension

oldpathname = swComp.GetPathName

Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路徑
Debug.Print Path
ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
Debug.Print ntype
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '舊文件名
Debug.Print oldfi
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
      mipname = InputBox("changename", "name", oldname) '新文件名

      mip = Path & mipname & ntype '新文件名帶路徑
      Debug.Print mip

If mip <> "" Then
      Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
   Debug.Print Status
   '========================
   '更改工程圖文件名
   Debug.Print Path
   tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
   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"
      Debug.Print newdrwname
      olddrwname = Path & tmpfi
      filecopy olddrwname,newdrwname '復(fù)制工程圖到新文件夾
      vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
      Debug.Print vDepend(1)
      bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴

      Debug.Print bl
      Exit Do
   End If
tmpfi = Dir
Debug.Print tmpfi
Loop
End If
End Sub

作者: ィ心兂鎅 時(shí)間: 2023-8-22 07:09
有版本限制嗎？

作者: cc851 時(shí)間: 2023-8-22 09:57
Solidworks自帶命名，就是不能關(guān)聯(lián)工程圖一起改而已。從設(shè)計(jì)流程來(lái)說(shuō)，改名在出圖之前。其實(shí)就無(wú)所謂要不要插件了。

作者: trongtrongtrong 時(shí)間: 2023-8-22 10:14
凱元工具也可以批量改名

作者: 怕瓦落地2011 時(shí)間: 2023-8-22 21:14

trongtrongtrong 發(fā)表于 2023-8-22 10:14
: c9 v; ]1 `7 d. z凱元工具也可以批量改名

授人以魚，不如授人以漁

作者: shasu 時(shí)間: 2023-8-24 16:19
謝謝版主分享

作者: liyizheng5566 時(shí)間: 2023-11-8 16:07
復(fù)制粘貼過(guò)去代碼錯(cuò)誤

作者: liyizheng5566 時(shí)間: 2023-11-8 16:08
顯示代碼錯(cuò)誤一片紅

作者: lonelysnakejj 時(shí)間: 2024-3-26 11:09
怎么拷貝好一些，復(fù)制都是亂碼

作者: Dustry 時(shí)間: 2024-4-3 13:29

運(yùn)行報(bào)錯(cuò)咋解決啊大佬

作者: Dustry 時(shí)間: 2024-4-3 14:26

Dustry 發(fā)表于 2024-4-3 13:29+ j9 z1 ~- g& s- _# Q0 D1 z. H
運(yùn)行報(bào)錯(cuò)咋解決啊大佬

Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
* R- H5 |3 V* j9 }* b6 ^. B對(duì)象不支持這個(gè)屬性或方法（錯(cuò)誤 438）

作者: peiyj 時(shí)間: 2024-4-4 12:44
運(yùn)行出錯(cuò)

作者: 頭鐵楊 時(shí)間: 2024-5-20 14:38
好用，如果再加個(gè)刪除原圖紙就更完美了

作者: 落葉luoyi 時(shí)間: 2024-5-23 13:01
提示編譯錯(cuò)誤：沒(méi)有適當(dāng)?shù)膶?duì)象，方法無(wú)效
大佬，這個(gè)怎么修改啊

作者: cot 時(shí)間: 2024-6-2 21:04
感謝

作者: 小菜雞123 時(shí)間: 2024-9-3 10:13

怕瓦落地2011 發(fā)表于 2023-8-22 21:14
: f+ w, ~1 t" w授人以魚，不如授人以漁

為什么復(fù)制了代碼，點(diǎn)擊了啟動(dòng)，沒(méi)有反應(yīng)，重新啟動(dòng)也沒(méi)有反應(yīng)，代碼里面紅色的，這個(gè)有關(guān)系嗎？

歡迎光臨機(jī)械社區(qū) (http://www.mg7058.com/)