宏例子: 打開指定目錄逐一處理所有零件的瑣事

僅供參考:

1. Sub Test()
   
2. Set swApp = Application.SldWorks
   
3. PartPath = "D:\Project" '設定目錄
   
4. PartFileName = Dir(PartPath & "*.sldprt") '搜尋首個零件檔案名稱
   
5. Do Until PartFileName = "" '直至搜尋到空值
   
6.     Set Part = swApp.OpenDoc(PartPath & PartFileName, 1) '開啟零件
   
7.     '加入所需語句
   
8.     '.
   
9.     '.
   
10.     '.
    
11.     '.
    
12.     Part.Save '保存
    
13.     swApp.CloseDoc (PartFileName) '關閉零件
    
14.     PartFileName = Dir '搜尋下一個零件檔案名稱
    
15. Loop '循環搜尋
    
16. End Sub

复制代码

wutong490 发表于 2014-11-18 23:29
知道了。
还请闷大测试，看能否遇到gif中的情况。

用您的宏略作修改：
1. 更正所有亂碼為GB碼
2. 補充"\"字符
3. 加上輸出位置的選項
4. 在3個對話框加上了具意義的標題

愛玩家 发表于 2014-11-20 11:59
估计是系统版本的问题。既有新的版本，旧的语法就让它过去吧!
俺自己有一些XP时代的宏拿来现在的系 ...

这是系统不同所引起，但不是版本，而是位元，32bit和64bit之别，欲兼容，可微调，详见连接：
https://msdn.microsoft.com/en-us ... v=office.15%29.aspx

例如配合以下鏈接2樓的代碼, 就可以批量修改同一目錄中所有工程圖內所有圖紙的名稱了.
https://www.icax.org/forum.php?mod=viewthread&tid=925975

【練習】用悶大的代碼加入鈑金的展開及抑制，達成「批量重整」模型

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Dim boolstatus As Boolean
   
4. Dim longstatus As Long, longwarnings As Long
   
5. Sub Test()
   
6. Set swApp = Application.SldWorks
   
7. PartPath = "C:\資料夾路徑" '設定目錄
   
8. PartFileName = Dir(PartPath & "*.sldprt") '搜尋首個零件檔案名稱
   
9. Do Until PartFileName = "" '直至搜尋到空值
   
10.     Set Part = swApp.OpenDoc(PartPath & PartFileName, 1) '開啟零件
    
11.     boolstatus = Part.Extension.SelectByID2("Flat-Pattern1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
    
12.     Part.ClearSelection2 True
    
13.     longstatus = Part.SetBendState(2)
    
14.     boolstatus = Part.EditRebuild3()
    
15.     boolstatus = Part.Extension.SelectByID2("Flat-Pattern1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
    
16.     Part.ClearSelection2 True
    
17.     longstatus = Part.SetBendState(3)
    
18.     boolstatus = Part.EditRebuild3()
    
19.     Part.Save '保存
    
20.     swApp.CloseDoc (PartFileName) '關閉零件
    
21.     PartFileName = Dir '搜尋下一個零件檔案名稱
    
22. Loop '循環搜尋
    
23. End Sub
    

复制代码

好贴不顶不行，谢谢版大分享

就算用了 InputBox, 依然只能處理一個目錄.
若要處理多個目錄, 就要動用"用戶窗體"的功能.

1. 插入>用戶窗體, 出現以下版面


2. 加入TextBox 及 CommandButton


3. TextBox1 的屬性 MultiLine 設定為 True


4. 雙擊 CommandButton, 貼上以下代碼:

1. Private Sub CommandButton1_Click()
   
2. Set swApp = Application.SldWorks
   
3. LoadExternalReferences = swApp.GetUserPreferenceIntegerValue(82)
   
4. swApp.SetUserPreferenceIntegerValue 82, 2
   
5. PartPaths = Split(TextBox1, Chr(13) & Chr(10))
   
6. For i = 0 To UBound(PartPaths)
   
7.     PartFileName = Dir(PartPaths(i) & "*.sldprt") '搜尋首個零件檔案名稱
   
8.     Do Until PartFileName = "" '直至搜尋到空值
   
9.         Set Part = swApp.OpenDoc(PartPaths(i) & PartFileName, 1) '開啟零件
   
10.         '加入所需語句
    
11.         '.
    
12.         '.
    
13.         '.
    
14.         '.
    
15.         Part.Save '保存
    
16.         swApp.CloseDoc (PartFileName) '關閉零件
    
17.         PartFileName = Dir '搜尋下一個零件檔案名稱
    
18.     Loop '循環搜尋
    
19. Next
    
20. swApp.SetUserPreferenceIntegerValue 82, LoadExternalReferences
    
21. Unload UserForm1
    
22. End Sub

复制代码

下一課: 彈出窗口點選目錄

  这个已经进入VB 教程了。。

不知有沒有成功例子

Francis 发表于 2014-9-27 23:00
不知有沒有成功例子

回覆悶哥…不成功…><

gt.adan 发表于 2014-11-3 15:12
回覆悶哥…不成功…><

謝謝丹弟測試。
可否上傳swp檔案，看看問題在哪。