批量輸出零件圖片，如何修改代碼以便兼顧到多組態零件？

benson2013

以下為等軸側視角批量輸出零件圖片的代碼（此代碼為網絡上大大分享的，在此謝謝原代碼作者）：

1. Sub ISOJPGSAVE()
   
2. Dim swApp As Object
   
3. Dim PathNames() As String
   
4. Dim FileNames() As String
   
5. HeaderRow = 2
   
6. RowNumber = HeaderRow + 1
   
7. Fcount = 0
   
8. Set swApp = CreateObject("SldWorks.Application") '啟動SW
   
9. Set Part = swApp.ActiveDoc
   
10. If Not (Part Is Nothing) Then
    
11.     YN = MsgBox("Some files are still opened in SolidWorks, It may cause errors." & Chr(13) & "Press 'Yes' to Continue or press 'No' to close files then run again.", vbYesNo)
    
12.     If YN <> 6 Then
    
13.         Exit Sub
    
14.     End If
    
15. End If
    
16. PathName = Cells(RowNumber, 1)
    
17. Filename = Cells(RowNumber, 2)
    
18. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
    
19. 
    
20.     Set Part = swApp.OpenDoc(PathName & Filename, 1) '開啟零件
    
21. 
    
22. Part.ShowNamedView2 "*Isometrisch", 7     '等轴测显示
    
23. Part.ViewZoomtofit2                        '视角最大化
    
24. 
    
25. sFilename = Left(Filename, Len(Filename) - 6)
    
26. 
    
27. sFilename = sFilename + "png"
    
28. 
    
29. longstatus = Part.SaveAs3(PathName & sFilename, 0, 0) '存为JPG文件
    
30. 
    
31. Part.Save '保存
    
32. Cells(RowNumber, 2).Interior.Color = RGB(255, 200, 200) '保存单元格变色
    
33. 
    
34. swApp.CloseDoc (PartFileName) '關閉零件
    
35. 
    
36.     Fcount = Fcount + 1
    
37.     RowNumber = RowNumber + 1 '下一列
    
38.     PathName = Cells(RowNumber, 1)
    
39.     Filename = Cells(RowNumber, 2)
    
40. Wend '回到>直到讀完路徑欄
    
41. 
    
42. 
    
43. If Not swApp.Visible Then
    
44.     swApp.ExitApp
    
45. End If
    
46. MsgBox "以最大化等轴测显示保存文件并另存为JPG文件完成"
    
47. End Sub

複製代碼

但此代碼，只能讀取硬盤裡存儲的零件檔案，無法兼顧到多組態零件。希望其輸出的圖片名稱格式為“零件檔案名稱+配置名稱”。該如何修改代碼，以便其兼顧帶多組態的零件呢？

gt.adan

樓主不厚道啊~只貼出部份代碼~

Francis

請參考：
http://www.solidworks.org.tw/for ... p;extra=&page=1
37樓

gt.adan

我有一樣的要求，所以之前就有試著修改代碼並且成功，用的參考正是悶哥的連結。
請注意除樓主貼圖的Sub以外，其他的如Sub BrowseDialog、Sub ISOJPGNOSAVE、Sub 自動插入圖片...也需修改。
看了一下要改的地方還真不少！我拋個磚，看樓主是不是有興趣自行研究一下~

1. Sub ISOJPGSAVE()
   
2. Dim swApp As Object
   
3. Dim PathNames() As String
   
4. Dim FileNames() As String
   
5. HeaderRow = 2
   
6. RowNumber = HeaderRow + 1
   
7. Fcount = 0
   
8. Set swApp = CreateObject("SldWorks.Application") '啟動SW
   
9. Set Part = swApp.ActiveDoc
   
10. If Not (Part Is Nothing) Then
    
11.     YN = MsgBox("Some files are still opened in SolidWorks, It may cause errors." & Chr(13) & "Press 'Yes' to Continue or press 'No' to close files then run again.", vbYesNo)
    
12.     If YN <> 6 Then
    
13.         Exit Sub
    
14.     End If
    
15. End If
    
16. PathName = Cells(RowNumber, 1)
    
17. Filename = Cells(RowNumber, 2)
    
18. ConfigName = Cells(RowNumber, 3)
    
19. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
    
20.     Set Part = swApp.OpenDoc(PathName & Filename, 1) '開啟零件
    
21. Part.ShowNamedView2 "*Isometrisch", 7     '等軸測顯示
    
22. Part.ViewZoomtofit2                        '視角最大化
    
23. sFilename = Left(Filename, Len(Filename) - 7) + ConfigName + ".jpg"
    
24. longstatus = Part.SaveAs3(PathName & sFilename, 0, 0) '存為JPG文件
    
25. Cells(RowNumber, 4) = sFilename '填寫JPG檔案名稱
    
26. Part.Save '保存
    
27. Cells(RowNumber, 2).Interior.Color = RGB(255, 200, 200) '保存單元格變色
    
28. 
    
29. swApp.CloseDoc (PartFileName) '關閉零件
    
30.     Fcount = Fcount + 1
    
31.     RowNumber = RowNumber + 1 '下一列
    
32.     PathName = Cells(RowNumber, 1)
    
33.     Filename = Cells(RowNumber, 2)
    
34.     ConfigName = Cells(RowNumber, 3)
    
35. Wend '回到>直到讀完路徑欄
    
36. 
    
37. If Not swApp.Visible Then
    
38.     swApp.ExitApp
    
39. End If
    
40. MsgBox "已完成" & Fcount & "個JPG文件"
    
41. End Sub

複製代碼

benson2013

gt.adan 發表於 2017/6/30 11:43
我有一樣的要求，所以之前就有試著修改代碼，用的參考正是悶哥的連結。
請注意除樓主貼圖的Sub以外，其他的 ...

謝謝分享代碼。該代碼解決了圖片名稱的問題。目前遇到多組態零件時，還是只打開默認的一個組態。
如圖（零件兩個組態的圖片名稱雖不同，但內容實為相同）：

打開多組態零件時，該如何自動遍歷打開每個零件的組態呢？
不知道該調用哪個API 函數？

benson2013

Francis 發表於 2017/6/29 13:05
請參考：
http://www.solidworks.org.tw/forum.php?mod=viewthread&tid=26079&extra=&page=1
37樓

謝謝悶大給的鏈接。

gt.adan

benson2013 發表於 2017/6/30 13:12
謝謝分享代碼。該代碼解決了圖片名稱的問題。目前遇到多組態零件時，還是只打開默認的一個組態。 ...

小提示。你必需"顯示當前組態"，否則代碼只是讀取組態名稱，而不會激活該組態。

benson2013

gt.adan 發表於 2017/6/30 14:25
小提示。你必需"顯示當前組態"，否則代碼只是讀取組態名稱，而不會激活該組態。

...

非常感謝提供代碼。試用後保存圖片及插入圖片正常。

另外的就是獲取屬性名稱及刪除屬性的代碼需要調整啦。

只能一步步慢慢來啦。

Francis

建議跟帖討論，像這樣另開主題發問，只會讓討論支離破碎，難以跟進。