SolidWorks專門論壇 SolidWorks forum

 找回密碼
 註冊
查看: 73992|回復: 246

無需運行solidworks程序, 批量修改檔案屬性

[複製鏈接]
發表於 2014/10/12 18:54:47 | 顯示全部樓層 |閱讀模式
看到標題, 各位可能會以為是 EPR 或 EPDM 的玩意,
其實是介紹一個利用 Excel 來實現批量修改工程圖檔案屬性的方法.

具體是採用 Excel 作為操作界面, (這樣就可以省卻許多複雜編程技巧)
再以 SolidWorks Document Manager API (注意: 與 SolidWorks API 是完全不同的一回事啊! ) 作為接口進行修改或增減SW檔案內部的屬性, 這是無需運行SW程序的, 甚至電腦沒有安裝SW軟體也可以的 (當然存在前設條件的),
速度估計比需要運行 SW 程序的 SolidWorks API 快 1000 倍以上.

以下附件是一個 Excel 檔案"臭臉翔.xls": (這檔案隨意放置即可, 不一定要與SW工程圖檔案一起存放的)


"臭臉翔.xls"的版面如下圖: (注意: 首次開啟可能會彈出"安全性警告", 停止了內裡的巨集, 只需點選"啟動內容"即可)


按一下 Alt+F11, 就可以看到非常簡單巨集的代碼, 如下圖: (此步驟可以跳過的)


準備幾個對應的SW工程圖檔案, 都是還沒有自訂屬性的, 如下圖:





本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/12 19:28:36 | 顯示全部樓層
回到 Excel, 按一下『執行代碼』, 輸入 SolidWorks Document Manager API 的許可證密碼, 瞬間就完成了, 見如下動畫:
(注意: 該許可證密碼, 是悶人向其中一個客戶所暫借的, 不可公開; 就算是悶人所擁有的, 也是不可能提供, 因為洩露該密碼後, 除了會失去軟體的使用權外, 更可能被追究法律責任的.)


查看剛才那幾個SW工程圖檔案的內部屬性, 屬性都已經加上了, 見下圖:






如果是有效的SW客戶, 可聯絡代理商, 查詢如何獲取該密碼.
當然, 有了該密碼後, 可以略為修改代碼, 跳過輸入許可證那步的對話框, 如下圖:


加入了許可證密碼的 Excel 檔案, 千萬不可交給非同一機構的人士, 若真的要向外發放 Excel 檔案, 必先刪除該密碼 或 把代碼加密.

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/13 12:36:50 | 顯示全部樓層
補充:
程式碼是以SW2013為基礎, 如果手頭版本不同, 需要到程式碼編輯器>工具>設定引用項目>加入"SwDocumentMgr 20?? Type Library", 見下圖:


本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/13 00:40:43 | 顯示全部樓層
衷心感謝悶大花了許久時間編寫此教程!
明早上班立馬詢問代理商,爾後才能跟進參與討論!
再次謝謝悶大!
 樓主| 發表於 2014/10/13 01:36:58 | 顯示全部樓層
gt.adan 發表於 2014/10/13 00:40
衷心感謝悶大花了許久時間編寫此教程!
明早上班立馬詢問代理商,爾後才能跟進參與討論!
再次謝謝悶大! ...

以下鏈接(3樓), 說明了如何從SW網站直接取得SWDM-API許可證.
http://fans.solidworks.com.cn/thread-35786-1-1.html
 樓主| 發表於 2014/10/14 12:16:52 | 顯示全部樓層
請問有誰成功獲取SWDM-API的許可證號碼? 在Excel的試驗效果如何? 悶人很想知道有否阻滯, 期待大家的回答, 謝謝!
發表於 2014/10/14 12:20:32 | 顯示全部樓層
在朋友的幫忙下,阿丹得以用最快的速度取得SWDM的KEY,
運行了悶大的代碼結果====>毫秒殺
現在能體會悶大說效率太高是什麼意思了~~^^
謝謝悶大提供一個機會讓大家有機會接觸到SWDM,
更謝謝悶大花寶貴時間寫教程,讓我體會到了直接調用 API ,秒速批次修改屬性的快感!
再多的謝謝仍言不及意,繼續追隨悶大學習!!!

















本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/14 12:44:19 | 顯示全部樓層
小翔苦苦寻求SWDM-API的许可证号码未果,只能眼睁睁看着丹大秒杀
發表於 2014/10/14 13:58:27 | 顯示全部樓層
報告悶老大,臭臉也成功應用了!

正在開心地使用著。

謝謝悶老大提供如此神兵利器

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/15 22:06:04 | 顯示全部樓層
臭臉翔 發表於 2014/10/14 13:58
報告悶老大,臭臉也成功應用了!

正在開心地使用著。

恭喜臭哥和丹哥成功應用, 並謝謝兩位積極參與.

但悶人相信還有改良之處, 例如:
1. 開啟按鈕, 彈出的對話框點選檔案, 幫助填寫路徑及檔案名稱
2. 提取工程圖屬性按鈕, 覆核之用
3. 提取工程圖內的零組件屬性按鈕, 有助人手填寫工程圖屬性
4. 零件/組合/工程圖 選項, 讓此程序可修改更多檔案類型的屬性
5. 切換圖頁格式按鈕
6. 輸出 PDF/JPG/DWG 的按鈕

希望各位踴躍參與討論, 集思廣益, 一同研究更完善的程式碼, 謝謝各位.
發表於 2014/10/15 22:15:33 | 顯示全部樓層
Francis 發表於 2014/10/15 22:06
恭喜臭哥和丹哥成功應用, 並謝謝兩位積極參與.

但悶人相信還有改良之處, 例如:

悶大思考的很全面呀~~希望大家真的能積極討論!
再次謝謝悶大的教程。
先請教悶大,SWDM有將屬性寫入配置的語法嗎?
 樓主| 發表於 2014/10/15 22:35:38 | 顯示全部樓層
gt.adan 發表於 2014/10/15 22:15
悶大思考的很全面呀~~希望大家真的能積極討論!
再次謝謝悶大的教程。
先請教悶大,SWDM有將屬性寫入配置 ...

丹哥應該是指 Configuration Specific (模型組態指定) 內的屬性,
SWDM-API 是可以讀寫這些資料的, 詳見Help. (其實悶人也在摸索中)
發表於 2014/10/16 08:33:12 | 顯示全部樓層
Francis 發表於 2014/10/15 22:06
恭喜臭哥和丹哥成功應用, 並謝謝兩位積極參與.

但悶人相信還有改良之處, 例如:

悶老大想得很周到阿!

目前使用上覺得如悶老大說的第一點,可以改用選擇檔案的方式的話,肯定事半功倍。

既然使用SWDM-API可以不用運行SW,那是不是可以拿來列印多張圖紙呢

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/16 09:03:03 | 顯示全部樓層
臭臉翔 發表於 2014/10/16 08:33
悶老大想得很周到阿!

目前使用上覺得如悶老大說的第一點,可以改用選擇檔案的方式的話,肯定事半功倍。

我有一個懶方法

用Excel 的功能~~ CTRL+K (插入超連結)
來選取檔案 也不用檔案輸入名稱



本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/16 11:05:50 | 顯示全部樓層
臭臉翔 發表於 2014/10/16 08:33
悶老大想得很周到阿!

目前使用上覺得如悶老大說的第一點,可以改用選擇檔案的方式的話,肯定事半功倍。

1. 第一點可用 Excel VBA 函數:Application.FileDialog 來實現, 建議臭哥嘗試一下.

2. 當然, 某些效果是必須運行SW程序的, 詳見 SWDM-API Help, 很詳細的.
 樓主| 發表於 2014/10/16 11:09:56 | 顯示全部樓層
judyyai 發表於 2014/10/16 09:03
我有一個懶方法

用Excel 的功能~~ CTRL+K (插入超連結)

感謝珠蒂妹參與討論並提供方法.

但方法只是"利用已輸入資料打開該檔案", 而不是原意的"利用對話框幫助填寫路徑及檔案名稱".
 樓主| 發表於 2014/10/16 11:16:22 | 顯示全部樓層
重申, 悶人只是在提供入門之法, 並非在提供客戶服務.

大陸有句話"自己動手 豐衣足食", 相信自行編寫小程序, 除了可得到貼身的功能, 還可以得到一份成功感, 若再能分享, 更是功德無量.
 樓主| 發表於 2014/10/16 15:11:07 | 顯示全部樓層
試下以下程式碼

彈出的對話框點選檔案的程式碼:
  1. Sub BrowseDialog()
  2. Dim intChoice As Integer
  3. Dim FilePathName As String
  4. Dim i As Integer
  5. RollNumber = 3
  6. PathName = Cells(RollNumber, 1) '讀取第一個路徑的值
  7. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
  8.     RollNumber = RollNumber + 1 '下一列
  9.     PathName = Cells(RollNumber, 1)
  10. Wend '回到>直到讀完路徑欄
  11. Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
  12. Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
  13. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "騷窩宮程圖", "*.SLDDRW" '設定檔案類型
  14. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
  15. If intChoice <> 0 Then '判斷有否點選檔案
  16.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
  17.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
  18.         FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
  19.         Filename = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
  20.         Cells(i + RollNumber - 1, 1) = FilePath '填寫路徑
  21.         Cells(i + RollNumber - 1, 2) = Filename '填寫檔案名稱
  22.     Next i
  23. End If
  24. End Sub
複製代碼
 樓主| 發表於 2014/10/16 15:47:48 | 顯示全部樓層
提取工程圖屬性的程式碼:
  1. Sub ReadSlddrwPrp()
  2. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  3. SWDMLicenseKey = InputBox("輸入許可證密碼")
  4. If SWDMLicenseKey = "" Then Exit Sub
  5. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  6. HeaderRoll = 2
  7. RollNumber = HeaderRoll + 1
  8. PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
  9. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  10.     Filename = ActiveSheet.Cells(RollNumber, 2)
  11.     Set swDoc = swDM.GetDocument(PathName & Filename, 3, False, mOpenErrors) '開啟
  12.     If Not swDoc Is Nothing Then
  13.         ColumnNumber = 3
  14.         PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
  15.         While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
  16.             PropValue = swDoc.GetCustomProperty(PropName, swDmCustomInfoText) '獲取屬性
  17.             Cells(RollNumber, ColumnNumber) = PropValue
  18.             ColumnNumber = ColumnNumber + 1 '下一欄
  19.             PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
  20.         Wend '回到>直到讀完表頭
  21.         swDoc.CloseDoc
  22.     End If
  23.     RollNumber = RollNumber + 1 '下一列
  24.     PathName = ActiveSheet.Cells(RollNumber, 1)
  25. Wend '回到>直到讀完路徑欄
  26. End Sub
複製代碼
 樓主| 發表於 2014/10/16 18:22:54 | 顯示全部樓層
做了一段粗淺動畫顯示過程, 希望可以對臭哥有點鼓勵.

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/16 18:31:51 | 顯示全部樓層
Francis 發表於 2014/10/16 18:22
做了一段粗淺動畫顯示過程, 希望可以對臭哥有點鼓勵.

好讚

剛成功在空白excel檔案做出巨集按鈕,但還沒有成功加到悶大給的excel檔案內

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/16 18:51:42 | 顯示全部樓層
臭臉翔 發表於 2014/10/16 18:31
好讚

剛成功在空白excel檔案做出巨集按鈕,但還沒有成功加到悶大給的excel檔案內 ...

不一定要出巨集按鈕的, 隨便一個圖案或圖片, 也可指定巨集的.

開啟悶人提供的 Excel檔案, 按一下 Alt+F11, 把以上兩段的程式碼插入到最後,
返回 Excel版面隨便插入兩個圖案, 各按右鍵指定巨集就可以了.
發表於 2014/10/16 20:40:32 | 顯示全部樓層
Francis 發表於 2014/10/16 15:47
提取工程圖屬性的程式碼:

下午就已貼好代碼,也做了巨集按鈕
但提取檔案屬性一直沒有成功…晚上再仔細看了一次…
原來「表頭」放錯欄位了…><,所以讀不到…
現在成功了!謝謝悶大教學!^^
發表於 2014/10/16 22:07:05 | 顯示全部樓層
Francis 發表於 2014/10/16 18:51
不一定要出巨集按鈕的, 隨便一個圖案或圖片, 也可指定巨集的.

開啟悶人提供的 Excel檔案, 按一下 Alt+F11 ...

悶哥~關於第一段 就是臭臉翔.xls那個
打開是亂碼 可否解譯一下 亂碼文字的意思有一些可以從悶哥的貼圖 大約知道~有一些就不能


本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/16 22:15:34 | 顯示全部樓層
gt.adan 發表於 2014/10/16 20:40
下午就已貼好代碼,也做了巨集按鈕
但提取檔案屬性一直沒有成功…晚上再仔細看了一次…
原來「表頭」放錯 ...

謝謝丹哥測試, 也欣賞丹哥勇於面對自己的不仔細.

讓悶人有感而發, 又要說一些悶話了.

悶人所見, 很多從事技術的人士, 都自以為掌握了技術, 瞧不起文職人員, 認為他們只是在做一些非技術性的黑板工作. 認為自己是公司的中流砥柱反得不到合理的待遇; 好像早前專門店這裡有位壇友發帖, 說自己曾贏得什麼的製圖獎項, 覺得公司的圖面不堪入目, 更對好心協助他的同時嗤之以鼻, 到論壇吐一口烏氣的舉動可見一斑. 可悶人找不到該帖子, 不好意思.

其實任何人也有他自己的一個故事, 每個平凡人的背後都不平凡.

悶人真心誠意, 希望可以幫助別人利用方法代替重複工作, 簡化流程從中減少人為錯誤, 更重要的是可以"自助", 利用手中僅有資源配合自己的想法, 編寫一些小程序應付日新月異的種種問題.

如果能把在這些小程序節約得來的時間, 好好利用來編寫更多的程序, 如此類推駕馭工作.

如果臭哥這次可以節省到時間, 希望臭哥可以抽空持續研習, 一來可以訓練邏輯思維, 又可以更好的配合工作.

千萬不要像燈具小翔般, 成功使用座標宏後就急不及待告訴上司, 而不是沉著應戰, 看看能否讓自己也能編寫出簡單又能解決問題的宏程序, 一時的稱讚隨時換來日後的逼迫, 相信燈具小翔的上司不需幾分鐘, 就把小翔這個短暫"功勞"消化, 小翔非但沒法利用省來的時間, 再有難題的話更是難找藉口說不.
 樓主| 發表於 2014/10/16 22:23:28 | 顯示全部樓層
judyyai 發表於 2014/10/16 22:07
悶哥~關於第一段 就是臭臉翔.xls那個
打開是亂碼 可否解譯一下 亂碼文字的意思有一些可以從悶哥的貼圖 大 ...

該段程式碼如下:
  1. Sub SLDDRW1()
  2. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  3. SWDMLicenseKey = InputBox("輸入許可證密碼")
  4. If SWDMLicenseKey = "" Then Exit Sub
  5. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  6. SavedFilesNumber = 0
  7. HeaderRoll = 2
  8. RollNumber = HeaderRoll + 1
  9. PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
  10. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  11.     Filename = ActiveSheet.Cells(RollNumber, 2)
  12.     Set swDoc = swDM.GetDocument(PathName & Filename, 3, False, mOpenErrors) '開啟
  13.     If Not swDoc Is Nothing Then
  14.         ColumnNumber = 3
  15.         PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
  16.         While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
  17.             PropValue = ActiveSheet.Cells(RollNumber, ColumnNumber)
  18.             swDoc.DeleteCustomProperty PropName '刪除屬性
  19.             swDoc.AddCustomProperty PropName, 30, PropValue '新增屬性
  20.             ColumnNumber = ColumnNumber + 1 '下一欄
  21.             PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
  22.         Wend '回到>直到讀完表頭
  23.         SaveOK = swDoc.Save
  24.         If SaveOK = 0 Then SavedFilesNumber = SavedFilesNumber + 1
  25.         swDoc.CloseDoc
  26.     End If
  27.     RollNumber = RollNumber + 1 '下一列
  28.     PathName = ActiveSheet.Cells(RollNumber, 1)
  29. Wend '回到>直到讀完路徑欄
  30. MsgBox "更新了 " & SavedFilesNumber & " 個檔案"
  31. End Sub
複製代碼
發表於 2014/10/16 22:45:49 | 顯示全部樓層
Francis 發表於 2014/10/16 22:23
該段程式碼如下:

謝謝悶哥~
有看到中文的意思~
再次感謝
發表於 2014/10/17 00:25:25 | 顯示全部樓層
再次謝謝悶大無私的教程和教誨~附上自己的操作畫面~~^^


本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/17 00:52:09 | 顯示全部樓層
悶老大#21說:「悶人只是在提供入門之法, 並非在提供客戶服務」,實在過於謙遜呀~^^
除了開帖的源文件,再看#24,#25的代碼便知~悶大實在佛心來著~~
有朋友問:悶大這個代碼超厲害,但是我比較需要的是「零件」的屬性批次修改而不是工程圖…
其實利用悶大的檔案和代碼,很容易修改的。多看幾次幫助或是悶大以前的教學就不難從中窺知一二。
尤其是悶大在重要代碼後面都有加註解說,就更容易看清楚了~^^

如下圖,將#24樓悶老大分享的「選擇檔案」代碼稍加修改即可!
紅線部份改成任何自己想定義的文字,例如:"SW零件"
藍色部份改成:*.SLDPRT


如此一來,就可以選擇到零件檔而非工程圖檔了。
===================================================
以上純粹分享使用心得,並不一定正確…望悶老大抽空指導~
===================================================

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/17 00:55:35 | 顯示全部樓層
gt.adan 發表於 2014/10/17 00:25
再次謝謝悶大無私的教程和教誨~附上自己的操作畫面~~^^

看到丹哥貼出漂亮版面, 非常高興!

讓悶人有動力 繼續研究"提取工程圖內的首個零組件屬性"的程式碼.
發表於 2014/10/17 09:00:01 | 顯示全部樓層
Francis 發表於 2014/10/16 18:51
不一定要出巨集按鈕的, 隨便一個圖案或圖片, 也可指定巨集的.

開啟悶人提供的 Excel檔案, 按一下 Alt+F11 ...

照著悶老大指示的步驟把另兩段程式碼做好了

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/17 11:27:00 | 顯示全部樓層
gt.adan 發表於 2014/10/17 00:52
悶老大#21說:「悶人只是在提供入門之法, 並非在提供客戶服務」,實在過於謙遜呀~^^
除了開帖的源文件,再 ...

1. 丹哥誤會了, 悶人只是希望各位不要以為這是"天降餡餅", 抱著圍觀檢好處的僥倖心態.

2. 要選擇其他檔案類型, 就是這樣編寫代碼, 丹哥的理解正確, 值得一讚.
 樓主| 發表於 2014/10/17 11:31:04 | 顯示全部樓層
臭臉翔 發表於 2014/10/17 09:00
照著悶老大指示的步驟把另兩段程式碼做好了

臭哥也成功了, 高興啊!

看到臭哥的"執行代碼"按鈕, 不禁會心微笑.
發表於 2014/10/17 11:38:36 | 顯示全部樓層
Francis 發表於 2014/10/17 11:31
臭哥也成功了, 高興啊!

看到臭哥的"執行代碼"按鈕, 不禁會心微笑.

是指代碼有三,不知執行的是哪一個嗎

那個我貼完圖之後發現不太對,有改成"修改屬性"。
 樓主| 發表於 2014/10/17 11:59:33 | 顯示全部樓層
臭臉翔 發表於 2014/10/17 11:38
是指代碼有三,不知執行的是哪一個嗎

暈!

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/17 12:15:45 | 顯示全部樓層
哈哈~臭大被洗臉了!
 樓主| 發表於 2014/10/17 13:33:32 | 顯示全部樓層
由於當檔案被其他軟體正在開啟的時候, 例如SW開啟了其中某幾個的工程圖, 就無法取讀這些檔案.
有個想法, 在 If Not swDoc Is Nothing Then 之後插入 Cells(RollNumber, 2).Interior.ColorIndex = 4,
以顏色顯示檔案是否已經被處理.
顏色的代表值見下圖: (圖片截圖自Excel-VBA-Help)

還可以刪除那一段彈出提示的程式碼 MsgBox "更新了 " & SavedFilesNumber & " 個檔案".

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/17 15:17:30 | 顯示全部樓層
我的進度慢了~

我目前只會改這個"開啟檔案"
(其實沒中文註解,VBA的內容不是很懂)




本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/17 16:06:19 | 顯示全部樓層
judyyai 發表於 2014/10/17 15:17
我的進度慢了~

我目前只會改這個"開啟檔案"

珠蒂妹真讚啊! (豎起大拇指的表情)
可以教教悶人騷窩靈劍劍法嗎? (多個類型的程式碼)
發表於 2014/10/17 16:10:53 | 顯示全部樓層
Francis 發表於 2014/10/17 16:06
珠蒂妹真讚啊! (豎起大拇指的表情)
可以教教悶人騷窩靈劍劍法嗎? (多個類型的程式碼) ...

因為有宮~當然就需要靈劍咩

我該認真一點,請問"多個類型的程式碼"這不是很懂

我比較想知道悶哥的"獨孤九劍"招式~~聽說失傳了
 樓主| 發表於 2014/10/17 16:38:47 | 顯示全部樓層
judyyai 發表於 2014/10/17 16:10
因為有宮~當然就需要靈劍咩

我該認真一點,請問"多個類型的程式碼"這不是很懂

就是珠蒂妹貼圖的效果.
如下圖:

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/17 16:41:37 | 顯示全部樓層
既然珠蒂妹不肯教, 那悶人獻醜了, 加入多個類型的程式碼如下:
  1. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "騷窩宮程圖", "*.SLDDRW" '設定檔案類型
  2. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "騷窩靈劍圖", "*.SLDPRT" '設定檔案類型
  3. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "騷窩珠盒圖", "*.SLDASM" '設定檔案類型
  4. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "所有類型", "*.*" '設定檔案類型
複製代碼
發表於 2014/10/17 16:44:42 | 顯示全部樓層
Francis 發表於 2014/10/17 16:38
就是珠蒂妹貼圖的效果.
如下圖:

已了解~
茱蒂是這麼做的 加入以下畫紅框


本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/17 16:49:57 | 顯示全部樓層



本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/17 16:51:08 | 顯示全部樓層
提取工程圖內的零組件屬性的程式碼已經寫好了, 相信對臭哥有一定的幫助.
  1. Sub ReadModelPrpInSlddrw()
  2. Dim swModel As SwDMDocument10
  3. Dim dmSearchOpt As SwDMSearchOption
  4. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  5. SWDMLicenseKey = InputBox("輸入許可證密碼")
  6. If SWDMLicenseKey = "" Then Exit Sub
  7. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  8. HeaderRoll = 2
  9. RollNumber = HeaderRoll + 1
  10. PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
  11. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  12.     Filename = ActiveSheet.Cells(RollNumber, 2)
  13.     Set swDoc = swDM.GetDocument(PathName & Filename, 3, False, mOpenErrors) '開啟工程圖
  14.     If Not swDoc Is Nothing Then
  15.         RefModelNames = swDoc.GetAllExternalReferences(dmSearchOpt) '獲取參考檔案名稱
  16.         If Not TypeName(RefModelNames) = "Empty" Then '過濾沒有參考檔案
  17.             Cells(RollNumber, 2).Interior.ColorIndex = 8
  18.             RefModelName = RefModelNames(0) '獲取第一個參考檔案的名稱
  19.             If "SLDPRT" = UCase(Left(RefModelName, 6)) Then '分辨參考檔案的類型
  20.                 RefModelTYpe = 1 '這是零件
  21.             Else
  22.                 RefModelTYpe = 2 '這是組合件
  23.             End If
  24.             Set swModel = swDM.GetDocument(RefModelName, RefModelTYpe, False, mOpenErrors) '開啟
  25.             ColumnNumber = 3
  26.             PropName = Cells(HeaderRoll, ColumnNumber)
  27.             While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
  28.                 PropNames = swModel.GetCustomPropertyNames '獲取模型內所有屬性的名稱
  29.                 HasPropName = False
  30.                 If Not IsEmpty(PropNames) Then
  31.                     For i = 0 To UBound(PropNames) '核對書否存在表單上的屬性名稱
  32.                         If UCase(PropNames(i)) = UCase(PropName) Then HasPropName = True
  33.                     Next
  34.                 End If
  35.                 If HasPropName Then
  36.                     PropValue = swModel.GetCustomProperty(PropName, swDmCustomInfoText) '獲取參考檔案的屬性
  37.                     Cells(RollNumber, ColumnNumber) = PropValue '寫入屬性到表格
  38.                 Else
  39.                     Cells(RollNumber, ColumnNumber) = "-----" '寫入代表不存在屬性的字符
  40.                 End If
  41.                 ColumnNumber = ColumnNumber + 1 '下一欄
  42.                 PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
  43.             Wend '回到>直到讀完表頭
  44.             swModel.CloseDoc '關閉參考檔案
  45.             Cells(RollNumber, ColumnNumber) = RefModelName '寫入參考檔案名稱到表格到行末
  46.             End If
  47.         swDoc.CloseDoc '關閉工程圖
  48.     End If
  49.     RollNumber = RollNumber + 1 '下一列
  50.     PathName = ActiveSheet.Cells(RollNumber, 1)
  51. Wend '回到>直到讀完路徑欄
  52. End Sub
複製代碼
發表於 2014/10/17 17:37:42 | 顯示全部樓層
Francis 發表於 2014/10/17 16:51
提取工程圖內的零組件屬性的程式碼已經寫好了, 相信對臭哥有一定的幫助.
...

謝謝悶老大

工作告個段落就來研究看看怎麼使用它。
 樓主| 發表於 2014/10/17 17:51:14 | 顯示全部樓層

丹哥, 參與一下悶人這個題目可以嗎:
http://bbs.icax.org/thread-951840-1-2.html
發表於 2014/10/17 18:01:28 | 顯示全部樓層
Francis 發表於 2014/10/17 17:51
丹哥, 參與一下悶人這個題目可以嗎:
http://bbs.icax.org/thread-951840-1-2.html

回覆悶大,阿丹豈敢怠惰…是還沒想到如何做…><  利用假日再研究!
發表於 2014/10/18 11:03:30 | 顯示全部樓層
Francis 發表於 2014/10/17 17:51
丹哥, 參與一下悶人這個題目可以嗎:
http://bbs.icax.org/thread-951840-1-2.html

請問悶大,54#的代碼就是用於這道題目嗎?
 樓主| 發表於 2014/10/18 12:59:01 | 顯示全部樓層
臭臉翔 發表於 2014/10/18 11:03
請問悶大,54#的代碼就是用於這道題目嗎?

請問臭大, 有試過54#那段程式碼嗎?
發表於 2014/10/18 14:21:39 | 顯示全部樓層
Francis 發表於 2014/10/18 12:59
請問臭大, 有試過54#那段程式碼嗎?

悶大抱歉,還在趕工作

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/20 09:28:30 | 顯示全部樓層
還以可討論的:
1. 可否顧及零件和組合及其模型組態
2. 沒有 SWDM-API 的 Key, 可否用較慢的 SW-API 代替, 慢總比沒得用好吧
3. 讀取及寫入屬性時, 是否一併處理"摘要"
4. 能否利用近似方法, 批量修改檔案名稱, 重點是不損關聯
發表於 2014/10/20 10:04:12 | 顯示全部樓層
Francis 發表於 2014/10/20 09:28
沒人跟進討論. 已經都滿足了? 還是被一大堆程式碼嚇怕了? (其實已經很簡短啦)

還以可討論的:

報告悶老大,我想先自首第二點...其實我沒有直接取得SWDM-API的Key,而是照著您教的步驟修改好excel檔案後,再請朋友幫忙填入並加密的。

而且我想大部分的使用者,應該很難取得SWDM-API的Key,如果有替代方法,肯定是一大福音。

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/21 10:55:26 | 顯示全部樓層
Francis 發表於 2014/10/20 09:28
沒人跟進討論. 已經都滿足了? 還是被一大堆程式碼嚇怕了? (其實已經很簡短啦)

還以可討論的:

1.如果零件有兩個組態特徵,數量不同,工序不同,這樣也能連結嗎@@

另外,如果一張工程圖裡放置多個零件,不知道能不能連結,避免輸入錯誤。
發表於 2014/10/21 14:17:57 | 顯示全部樓層
Francis 發表於 2014/10/17 16:51
提取工程圖內的零組件屬性的程式碼已經寫好了, 相信對臭哥有一定的幫助.
...

請問悶哥
茱蒂不了解這個程式使用情形
又加上沒 "SWDM-API 許可號碼" 無法測試
發表於 2014/10/21 22:31:57 | 顯示全部樓層
Francis 發表於 2014/10/21 16:02
沒有SWDM-API的KEY, 就沒必要在本主題參與討論了.
應到以下鏈接參與討論:
http://www.solidworks.org.tw/ ...

回覆悶哥

我大概知道54# 代碼的意思(不知理解是否正確)

在Excel巨集時
開啟工程圖,用此代碼可以讀取到 屬於這個工程圖內 零件之屬性值

我的作法~
1.開工程圖  
2.讀取零件屬性  
3.修改零件屬性再寫入<=昨錯的

10/22補充  
   正確 => 修改屬性後,寫入修正是"工程圖屬性"非零件屬性
因為,開啟檔案類型,寫入的地方,是以它為主

修改前


修改後->寫入修正是"工程圖屬性"非零件屬性


PS.第二篇,無需 SWDM-API 許可號碼 我在那篇有回覆



本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/22 01:11:50 | 顯示全部樓層
以下幾點向悶老大請教與討論~
1.阿丹反覆試驗這些代碼,發現除了可以實現幾個「屬性欄位完全空白」的SW檔案,也可以批次生成新的屬性或是修改,
   那是否也可以做到批次「刪除」屬性欄呢?若是不在此帖應該討論的範疇,再煩請悶大告訴我~^^
2.#54樓的代碼輔導長有測試過了,這裡就不再重覆貼圖。
   按悶大 SLDDRW()1 中的代碼,看著應該是將變更後的屬性值批次存回去當初打開的檔案裡…
   請問悶大讀到工程圖中的零組件的屬性了,那…更改完屬性值以後,要如何存回對應的零件中,而不是工程圖中呢?
發表於 2014/10/22 10:58:17 | 顯示全部樓層
Francis 發表於 2014/10/22 02:14
回覆丹哥:
1. 可以的, 修改一下程式碼就可以, 比如刪除新增屬性的那一句, 不過要注意, 刪除後就不可以恢復 ...

非常謝謝悶大這麼晚了還抽空為阿丹釋疑說明。
實在是我們幾個晚輩自行私下討論,結果狀況百出、得到的情況不儘相同…
才努力整合了一下向您提問。
誠如悶大所說,如果我們不就發問的本質深入探索,而是假想額外的功能(例如我樓上的提問…)
那麼此帖將逐漸失去參與討論的積極性。
再次謝謝您的說明!^^
發表於 2014/10/22 11:52:55 | 顯示全部樓層
Francis 發表於 2014/10/22 11:16
超級非常謝謝丹哥這麼彬彬有禮抽空回覆悶人的廢話.
為什麼要私下討論呢? 難道悶人已經成為公敵?
為什麼不 ...

很抱歉,阿丹不擅言辭,再次誤導了悶大我想表達的原意…

私下討論的目的:
此帖只見少數人參與…根本談不上討論…
由於我們幾個對API連入門都談不上,只能用悶大提供的代碼和朋友提供的許可號亂改亂試…
深怕問題太草率、太不入流而讓您生氣。所以才說私下討論…如今整合問題和情況後再提出向您求指導。

阿丹向天借膽也不敢質疑您的帖子是讓大家失去積極性的元兇…
所謂「假想額外的功能」並非指悶大說要完善的部份呀!
而是指我們後來的要求已經如您所說的「越扯越遠」了…
所以才希望有討論的人回歸當初提問的要求本質,繼續深入的求教於悶大。
而不是另外一直天馬行空的多加新功能和新要求。

以上,望悶大消氣…
發表於 2014/10/22 12:22:54 | 顯示全部樓層
Francis 發表於 2014/10/22 11:16
超級非常謝謝丹哥這麼彬彬有禮抽空回覆悶人的廢話.
為什麼要私下討論呢? 難道悶人已經成為公敵?
為什麼不 ...

悶老大給的資訊很詳細、專業,但礙於我們對於API實在一竅不通,所以才私下討論一些如何操作或者修改等等基礎的東西,又或者天馬行空地提出不入流的空想(指我自己)。因為覺得這些我們應該自己摸索、學習,而不該連這樣的問題都丟上來打擾悶大。希望藉由小組討論再發問的方式,來減少悶大的不便。但因為我的胡亂發言又導致這樣的結果,也讓悶老大不悅。抱歉...
發表於 2014/10/22 12:28:33 | 顯示全部樓層
Francis 發表於 2014/10/22 11:36
回看自己的回帖, 悶人自己也不知道在問珠蒂妹什麼?

可能要這樣問才可以:
Could you let me know the program code for multiple file types in the filter option?

回覆悶哥

VBA程式我真的不懂,多種類型的程式碼,是我誤打誤撞成功的...
當時悶哥說要我教你~我以為你在開玩笑,認真認為你會~所以不懂你的意思.
後來知道了,悶哥的用意~其實是要我反教看此篇討論的人.

老實說,本來看到程式,會覺得怕怕,(本身英文不好程式碼又不懂)
但,因為悶哥指導,所以才想更進一步去了解~

另外~茱蒂的英文非常不好是靠翻譯了解其意思

以下與本文無關(僅交代誤打誤撞過程)
我是參考google 搜尋教學(網址我找不到了)~底下代碼 fd.Filters.Add "Excel File", "*.xls*" '


  1. Private Sub cmdPickFileDialog_Click()
  2.     Dim fd As FileDialog    '宣告一個檔案對話框
  3.    
  4.     Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  5.    
  6.    
  7.     fd.Filters.Clear    '清除之前的資料
  8.    
  9.     fd.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名
  10.     fd.Filters.Add "Word File", "*.doc*"
  11.     fd.Filters.Add "所有檔案", "*.*"
複製代碼

發表於 2014/10/23 12:05:51 | 顯示全部樓層
悶大連夜發教程,如此好帖卻無人跟進討論,看著很是覺得可惜…
阿丹有幸得代理商朋友協助很快的拿到SWDM許可號,立馬連著幾夜動手試做!
稍有心得就雀躍不已!趕緊分享給幾個好友請他們也一起體驗悶大的教程帶來的便利性。
往來的過程中不是沒問題,但是鑑於過去的經驗,悶大發帖向來嚴謹、考慮周全,
且絕大多數代碼都是要動手實作後才得以窺得其中一二分…
我們幾個只因深怕問題太不入流!怕與原討論太背道而馳!怕表達得不得體不周全讓悶大又生氣…所以幾次都忍著「不敢問」!
就只想著動手試過了,得到了幾種可能性、問題或是新的想法,「整合過後才好發問」求教於悶大再接續討論。
稍和我有交情的朋友,每個都知道我一向尊敬悶大!而且樂於在論壇分享悶大的教程給其他無緣看見的網友。
絕非藉著悶大無私公開的代碼進行「私下討論不分享」或是「私相授受」等情況。
而這些也向悶大解釋過了,我並無任何不敬呀!真的不理解悶大為何對「私下」二字如此不諒解
不諒解的程度可以一直用以往的帖子一次又一次的揶揄我?還要從幾何說到開思?
我已經不知如何說明才能讓悶大消氣了,#77樓已經再次向悶大說明,但顯然的是達到反效果…
更確切的來說,真心不知道我做錯什麼了:我,是全程中唯一拿到許可號並積極參與悶大討論的人呀

話說也是此討論的起源!我私訊了悶大一短訊,內容大致是說,
我不擅言詞說話沒腦不得體,我都認了…
希望悶大在我做錯說錯時直白一點的糾正我,幹譙我,用力鞭我都沒關係!
而如今看來,這些都不是悶大能接受的方式…
悶大從昨天下午發脾氣開始,就一直不斷的回覆他人帖子,我擷取「部份」回文內容如下:
「找丹哥私下討論比較好」
「 沒用過 iMOLD, 不了解具體情況, 建議向丹大私下求助, 保證得到滿意答案.」
「不會做這題目的朋友注意, 私下向丹大請益吧, 保證得到完美答覆的呀」
樓主的問題還沒解決, 原因很簡單>>>>沒有和丹大私下討論.」
「最重要是經常私下討論, 才可以顯示蛋大的卓越」
「 快跟丹大私下討論, 說不定可以得到那個許可號的呀!!!!」  
                              
                              。
                              。
                              。

悶大呀悶大,能不能告訴我,我究竟做錯了什麼?說錯了什麼?!
能讓悶大用如此報復性的回文來調侃我、諷刺我?!
麻煩請告訴我可以嗎!人家說,死,都要死得明明白白的是為了什麼!!

===========================================
以上…昨晚已經寫好,但猶豫了一晚上…發?還是不發?
發了,只怕悶大以其難以捉摸的個性又會「出走」…
一些對於悶大動向殷殷切切的朋友(包含以前的我)來說,也許又會一段時間看不見悶大…
發了,只怕跟著悶大的帖子學習幾年的我,將在這裡結束我自認難得的緣份…
所以,我忍住了…選擇像以往以樣…當悶大的炮灰,我一個夠了!


結果,今天早上…我竟然看見悶大直到昨晚還在其他論壇做一樣的回文動作
真心不了解悶大這樣做的原因?也不明白悶大這樣做想看到什麼結果?
這不是在問悶大,更不是在討答案,因為從今天開始已經不再重要了。
從XX冒犯悶大那次,我的回應就足以證明對於悶大的尊重與推祟!有看過的人都明白我在說什麼!
我自認一向有什麼就說什麼,罵人更是不會轉彎!所以再寫下去…話就真的不好聽了。
心中仍留有對悶大的敬意,但從此僅止於學術上,其他的就不再多說了。





 樓主| 發表於 2014/10/29 01:12:37 | 顯示全部樓層
wutong490 發表於 2014/10/28 20:17
期待更精彩实用的内容

來了
用法參考以下帖子#7樓
http://www.solidworks.org.tw/for ... 210&fromuid=151

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/29 18:55:48 | 顯示全部樓層
改良了一下,連同“摘要”也顧及了。密碼不變。
已經核實可以寫入摘要、自訂屬性 及 組態指定的了。
注意,處理的檔案不可在SW開啟中。


本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/29 19:31:32 | 顯示全部樓層
更正一下圖片

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/29 21:47:02 | 顯示全部樓層
这个 功能太强大了,可以作为单独扑助软件发布了把?????
發表於 2014/10/30 08:42:59 | 顯示全部樓層

這真的太神了

謝謝悶哥^^
 樓主| 發表於 2014/10/30 15:41:38 | 顯示全部樓層
再改良了一下:
1. 工作表可被複製,一個Excel檔案就可以含有多個工作表,簡化處理多樣的情況或記錄一些設定。
2. 美化按鈕的外觀。
3. 修正了『刪除屬性』功能。
4. 加上了『獲取屬性名稱』功能。
5. 兼容純數字的屬性名稱.


解壓密碼沒變

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/30 16:04:22 | 顯示全部樓層
Francis 發表於 2014/10/30 15:41
再改良了一下:
1. 工作表可被複製,一個Excel檔案就可以含有多個工作表,簡化處理多樣的情況或記錄一些設 ...

有了【獲取屬性名稱】再加上可複製,效率提高非常多阿

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/30 17:35:06 | 顯示全部樓層
發現『刪除列表所有屬性』的按鈕錯誤地指定了“讀取屬性”巨集,附件已修補,請重新下載,密碼不變。
補充:請使用『瀏覽檔案』按鈕填寫首3欄位,不要手動輸入,以免出錯。

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/10/30 22:05:30 | 顯示全部樓層
经测试  带配置的2015版零件选取后不能读入名称和配置

还有人测试过吗?

提供一个15版的带配置的零件  

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/30 22:30:40 | 顯示全部樓層
wutong490 發表於 2014/10/30 22:05
经测试  带配置的2015版零件选取后不能读入名称和配置

还有人测试过吗?

SW2015是一個新開端,是擺脫32位元(純64位元)的首個版次,軟體變化巨大。
見連接:
http://help.solidworks.com/2015/ ... 10b9f5572bf12c8061f
在2015版次重置了SWDM-API的許可證號碼,抱歉這個Excel程序是不支援2015版次的。

有關2015的巨大變化,可從一篇SW產品開發總監的訪問了解因由,見連接:
http://michaellord.me/2014/09/22 ... -solidworks-sw2015/
發表於 2014/10/31 00:48:15 | 顯示全部樓層
悶大,晚安。。。(先謝謝阿翔告知有您的回帖)
悶大在SW領域裡德高望眾。對阿丹來說,您即便不是長輩,也是令人倏然起敬的前輩,
要說「原諒」實在不妥,更是對您的不敬。(沒聽說過晚輩原諒長輩的禮節吧?!)
要說釋懷,阿丹早在最後一次點擊「發送」鈕貼文之後,就已經釋懷了。
要說生氣,實則一點兒也沒有;取而代之是更多的難過。會難過正是因為太尊重您,所以特別重視您對阿丹的任何批評和教誨。
已經…好多天沒有上論壇,更沒有開SW的動力…如今見到悶大在水母寶寶那兒的回帖,在震驚了半晌以後,對悶大的器度和敬佩又加了幾分。


阿丹不是不懂尊師重道之人,看完悶大留言,知道是回應悶大善意的時候了。
悶大在很多領域都是佼佼者,其他不說,單就SW而言,
您在SW的領域裡這許多年來的貢獻和付出和對軟件開發深入的程度,絕對是無人能出其左右的!

只是您的級別和能力實在太深太高,常常都有「曲高和寡」的遺珠之憾。但是吾等後輩則不是這樣子想的喲~
「還好我們有悶大!」這句話,是我們幾個好朋友討論工作上或在研究軟體上問題無法解決時想到的「結論」~

悶大,謝謝您願意耐著性子釋出善意,更謝謝您一直無私的分享而不求回報,日後還當繼續向您學習求指導!
「哪邊開始,哪邊結束」。您在水母寶寶帖子留的言,阿丹在此處回覆,請悶大原諒。
其他的不多說,再說就顯得阿丹矯情了。言盡於此,再次謝謝悶大的善意。祝   晚安。

PS. 很多天沒上論壇,沒有跟上悶大後來分享的教程和練習,待週末與家人出遊後自當努力追上進度。


發表於 2014/10/31 08:26:16 | 顯示全部樓層
Francis 發表於 2014/10/30 17:35
發現『刪除列表所有屬性』的按鈕錯誤地指定了“讀取屬性”巨集,附件已修補,請重新下載,密碼不變。
補充 ...

試用過了,成功!

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2014/10/31 10:07:43 | 顯示全部樓層
昨晚看到阿丹的回覆,感到如釋重負,本來應該馬上回覆以表示謝意,
但想到有可能跟丹哥一直聊到天明,不知不覺影響了雙方作息,還是睡覺了,而且睡得好。

本來打了一大篇文字,吃過早點沉澱思緒後,回頭再看,發現言中無物並過於矯情,還是修正一下,越修越短,只剩下一句:『盡在不言中』。

感謝阿丹!
 樓主| 發表於 2014/10/31 22:09:28 | 顯示全部樓層
程式碼如下:
  1. Const SWDMLicenseKey = "許可號碼"
  2. Dim swDM As SwDMApplication
  3. Dim swDoc As SwDMDocument12
  4. Dim mOpenErrors As SwDmDocumentOpenError
  5. Dim swCfgMgr As SwDMConfigurationMgr
  6. Dim objClassfac As SwDMClassFactory
  7. Dim vCustPropNameArr As Variant

  8. Sub BrowseFiles()
  9. Range("A3").Activate
  10. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  11. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  12. Dim vCfgNameArr As Object
  13. Dim vCfgName As Object
  14. Dim swCfg As SwDMConfiguration '14
  15. Dim nPropType As Long
  16. Dim PropList() As String
  17. ReDim PropList(0)
  18. PropList(0) = ""
  19. Dim intChoice As Integer
  20. Dim FilePathName As String
  21. Dim i As Integer
  22. HeaderRow = 2
  23. RowNumber = 3
  24. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  25. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
  26.     RowNumber = RowNumber + 1 '下一列
  27.     PathName = Cells(RowNumber, 1)
  28. Wend '回到>直到讀完路徑欄
  29. Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
  30. Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
  31. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Part", "*.SLDPRT" '設定檔案類型
  32. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Part with Configs", "*.SLDPRT" '設定檔案類型
  33. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Asm", "*.SLDASM" '設定檔案類型
  34. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Asm with Configs", "*.SLDASM" '設定檔案類型
  35. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Drawing", "*.SLDDRW" '設定檔案類型
  36. If Cells(1, 1) = 1 Or Cells(1, 1) = 2 Or Cells(1, 1) = 3 Or Cells(1, 1) = 4 Or Cells(1, 1) = 5 Then
  37.     Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
  38. End If
  39. If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
  40. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框

  41. If intChoice <> 0 Then '判斷有否點選檔案
  42.     RowCount = 1
  43.     swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
  44.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
  45.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
  46.         FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
  47.         FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
  48.         FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
  49.         If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
  50.             Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  51.             Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  52.             RowCount = RowCount + 1
  53.         End If
  54.         If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
  55.             Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
  56.             If Not swDoc Is Nothing Then '排除無效檔案
  57.                 Set swCfgMgr = swDoc.ConfigurationManager
  58.                 swConfigNames = swCfgMgr.GetConfigurationNames
  59.                 ConfigColor = 200
  60.                 For Each swConfigName In swConfigNames
  61.                     Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  62.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  63.                     If TypeName(vCustPropNameArr) = "String()" Then
  64.                          For Each vCustPropName In vCustPropNameArr
  65.                              InList = False
  66.                              For Each PropItem In PropList
  67.                                 If vCustPropName = PropItem Then InList = True
  68.                              Next
  69.                              If Not InList Then
  70.                                 ReDim Preserve PropList(UBound(PropList) + 1)
  71.                                 PropList(UBound(PropList)) = vCustPropName
  72.                              End If
  73.                         Next
  74.                     End If
  75.                     Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  76.                     Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  77.                     Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
  78.                     Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(ConfigColor, ConfigColor, ConfigColor)
  79.                     ConfigColor = ConfigColor - 10
  80.                     RowCount = RowCount + 1
  81.                 Next
  82.                 swDoc.CloseDoc '關閉檔案
  83.             End If '排除無效檔案<完>
  84.         End If ''過濾器是2或4<完>
  85.     Next i '逐一讀取所選檔案<完>
  86. End If '判斷有否點選檔案<完>
  87. End Sub

  88. Sub ReadProps()
  89. Dim swCfg As SwDMConfiguration '14
  90. Dim HeaderRow As Integer
  91. Dim RowNumber As Integer
  92. Dim FileName As String
  93. Dim swExtName As String
  94. Dim swFileTYpe As Integer
  95. Dim swConfigName As String
  96. Dim vCustPropName
  97. Dim PropValue As String
  98. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  99. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  100. HeaderRow = 2
  101. RowNumber = HeaderRow + 1
  102. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  103. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  104.     FileName = Cells(RowNumber, 2)
  105.     FileExtname = UCase(Right(Cells(RowNumber, 2), 6))
  106.     If "SLDPRT" = FileExtname Then swFileTYpe = 1
  107.     If "SLDASM" = FileExtname Then swFileTYpe = 2
  108.     If "SLDDRW" = FileExtname Then swFileTYpe = 3
  109.     Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟
  110.     If Not swDoc Is Nothing Then
  111.         If swFileTYpe = 1 Or swFileTYpe = 2 Then
  112.             If Not (Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0) Then
  113.                 Set swCfgMgr = swDoc.ConfigurationManager
  114.                 swConfigName = Cells(RowNumber, 3)
  115.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  116.             End If
  117.         End If
  118.         ColumnNumber = 4
  119.         PropName = Cells(HeaderRow, ColumnNumber)
  120.         While Not (PropName = "" Or PropName = 0) 'Or IsEmpty(PropName)) '直到讀完表頭
  121.             PropName = PropName & ""
  122.             If PropName = "$Author$" Then '作者
  123.                 Cells(RowNumber, ColumnNumber) = swDoc.Author
  124.             ElseIf PropName = "$Keywords$" Then '標記
  125.                 Cells(RowNumber, ColumnNumber) = swDoc.Keywords
  126.             ElseIf PropName = "$Comments$" Then '註解
  127.                 Cells(RowNumber, ColumnNumber) = swDoc.Comments
  128.             ElseIf PropName = "$Subject$" Then '主題
  129.                 Cells(RowNumber, ColumnNumber) = swDoc.Subject
  130.             ElseIf PropName = "$Title$" Then '標題
  131.                 Cells(RowNumber, ColumnNumber) = swDoc.Title
  132.             Else
  133.                 If Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0 Then '模型組態欄位是否空值
  134.                     vCustPropNameArr = swDoc.GetCustomPropertyNames '是
  135.                     If TypeName(vCustPropNameArr) = "String()" Then
  136.                          For Each vCustPropName In vCustPropNameArr
  137.                             If PropName = vCustPropName Then
  138.                                 PropValue = swDoc.GetCustomProperty(PropName, swDmCustomInfoText) '獲取屬性
  139.                                 Cells(RowNumber, ColumnNumber) = PropValue
  140.                             End If
  141.                         Next
  142.                     End If
  143.                 Else '否
  144.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  145.                     If TypeName(vCustPropNameArr) = "String()" Then
  146.                          For Each vCustPropName In vCustPropNameArr
  147.                             If PropName = vCustPropName Then
  148.                                 PropValue = swCfg.GetCustomProperty(PropName, swDmCustomInfoText) '獲取屬性
  149.                                 Cells(RowNumber, ColumnNumber) = PropValue
  150.                             End If
  151.                         Next
  152.                     End If
  153.                 End If
  154.             End If
  155.             ColumnNumber = ColumnNumber + 1 '下一欄
  156.             PropName = Cells(HeaderRow, ColumnNumber)
  157.         Wend '回到>直到讀完表頭
  158.         swDoc.CloseDoc
  159.         Cells(RowNumber, 1).Interior.Color = RGB(200, 255, 200)
  160.     Else
  161.         Cells(RowNumber, 1).Interior.Pattern = xlNoneColor
  162.     End If
  163.     RowNumber = RowNumber + 1 '下一列
  164.     PathName = Cells(RowNumber, 1)
  165. Wend '回到>直到讀完路徑欄
  166. End Sub

  167. Sub WriteProps()
  168. Dim swCfg As SwDMConfiguration '14
  169. Dim HeaderRow As Integer
  170. Dim RowNumber As Integer
  171. Dim FileName As String
  172. Dim swExtName As String
  173. Dim swFileTYpe As Integer
  174. Dim swConfigName As String
  175. Dim vCustPropName
  176. Dim PropValue As String
  177. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  178. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  179. HeaderRow = 2
  180. RowNumber = HeaderRow + 1
  181. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  182. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  183.     FileName = Cells(RowNumber, 2)
  184.     FileExtname = UCase(Right(Cells(RowNumber, 2), 6))
  185.     If "SLDPRT" = FileExtname Then swFileTYpe = 1
  186.     If "SLDASM" = FileExtname Then swFileTYpe = 2
  187.     If "SLDDRW" = FileExtname Then swFileTYpe = 3
  188.     Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟
  189.     If Not swDoc Is Nothing Then
  190.         If swFileTYpe = 1 Or swFileTYpe = 2 Then
  191.             If Not (Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0) Then
  192.                 Set swCfgMgr = swDoc.ConfigurationManager
  193.                 swConfigName = Cells(RowNumber, 3)
  194.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  195.             End If
  196.         End If
  197.         ColumnNumber = 4
  198.         PropName = Cells(HeaderRow, ColumnNumber)
  199.         While Not (PropName = "" Or PropName = 0) 'Or IsEmpty(PropName)) '直到讀完表頭
  200.             PropName = PropName & ""
  201.             If PropName = "$Author$" Then '作者
  202.                 swDoc.Author = Cells(RowNumber, ColumnNumber)
  203.             ElseIf PropName = "$Keywords$" Then '標記
  204.                 swDoc.Keywords = Cells(RowNumber, ColumnNumber)
  205.             ElseIf PropName = "$Comments$" Then '註解
  206.                 swDoc.Comments = Cells(RowNumber, ColumnNumber)
  207.             ElseIf PropName = "$Subject$" Then '主題
  208.                 swDoc.Subject = Cells(RowNumber, ColumnNumber)
  209.             ElseIf PropName = "$Title$" Then '標題
  210.                 swDoc.Title = Cells(RowNumber, ColumnNumber)
  211.             Else
  212.                 If Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0 Then '模型組態欄位是否空值
  213.                     PropValue = Cells(RowNumber, ColumnNumber)
  214.                     swDoc.DeleteCustomProperty PropName '刪除屬性
  215.                     swDoc.AddCustomProperty PropName, 30, PropValue '新增屬性
  216.                 Else '否
  217.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  218.                     PropValue = Cells(RowNumber, ColumnNumber)
  219.                     swCfg.DeleteCustomProperty PropName '刪除屬性
  220.                     swCfg.AddCustomProperty PropName, 30, PropValue '新增屬性
  221.                 End If
  222.             End If
  223.             ColumnNumber = ColumnNumber + 1 '下一欄
  224.             PropName = Cells(HeaderRow, ColumnNumber)
  225.         Wend '回到>直到讀完表頭
  226.         swDoc.Save
  227.         swDoc.CloseDoc
  228.         Cells(RowNumber, 1).Interior.Color = RGB(255, 255, 200)
  229.     Else
  230.         Cells(RowNumber, 1).Interior.Pattern = xlNoneColor
  231.     End If
  232.     RowNumber = RowNumber + 1 '下一列
  233.     PathName = Cells(RowNumber, 1)
  234. Wend '回到>直到讀完路徑欄
  235. End Sub

  236. Sub DeleteProps()
  237. YN = MsgBox("Once Deleted, those cannot be restored. Continue?", vbYesNo)
  238. If YN <> 6 Then Exit Sub
  239. Dim swCfg As SwDMConfiguration '14
  240. Dim HeaderRow As Integer
  241. Dim RowNumber As Integer
  242. Dim FileName As String
  243. Dim swExtName As String
  244. Dim swFileTYpe As Integer
  245. Dim swConfigName As String
  246. Dim vCustPropName
  247. Dim PropValue As String
  248. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  249. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  250. HeaderRow = 2
  251. RowNumber = HeaderRow + 1
  252. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  253. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  254.     FileName = Cells(RowNumber, 2)
  255.     FileExtname = UCase(Right(Cells(RowNumber, 2), 6))
  256.     If "SLDPRT" = FileExtname Then swFileTYpe = 1
  257.     If "SLDASM" = FileExtname Then swFileTYpe = 2
  258.     If "SLDDRW" = FileExtname Then swFileTYpe = 3
  259.     Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟
  260.     If Not swDoc Is Nothing Then
  261.         If swFileTYpe = 1 Or swFileTYpe = 2 Then
  262.             If Not (Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0) Then
  263.                 Set swCfgMgr = swDoc.ConfigurationManager
  264.                 swConfigName = Cells(RowNumber, 3)
  265.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  266.             End If
  267.         End If
  268.         ColumnNumber = 4
  269.         PropName = Cells(HeaderRow, ColumnNumber)
  270.         While Not (PropName = "" Or PropName = 0) 'Or IsEmpty(PropName)) '直到讀完表頭
  271.             PropName = PropName & ""
  272.             If PropName = "$Author$" Then '作者
  273.             ElseIf PropName = "$Keywords$" Then '標記
  274.             ElseIf PropName = "$Comments$" Then '註解
  275.             ElseIf PropName = "$Subject$" Then '主題
  276.             ElseIf PropName = "$Title$" Then '標題
  277.             Else
  278.                 If Cells(RowNumber, 3) = "" Or Cells(RowNumber, 3) = 0 Then '模型組態欄位是否空值
  279.                     PropValue = Cells(RowNumber, ColumnNumber)
  280.                     swDoc.DeleteCustomProperty PropName '刪除屬性
  281.                 Else '否
  282.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  283.                     PropValue = Cells(RowNumber, ColumnNumber)
  284.                     swCfg.DeleteCustomProperty PropName '刪除屬性
  285.                 End If
  286.             End If
  287.             ColumnNumber = ColumnNumber + 1 '下一欄
  288.             PropName = Cells(HeaderRow, ColumnNumber)
  289.         Wend '回到>直到讀完表頭
  290.         swDoc.Save
  291.         swDoc.CloseDoc
  292.         Cells(RowNumber, 1).Interior.Color = RGB(255, 50, 50)
  293.     Else
  294.         Cells(RowNumber, 1).Interior.Pattern = xlNoneColor
  295.     End If
  296.     RowNumber = RowNumber + 1 '下一列
  297.     PathName = Cells(RowNumber, 1)
  298. Wend '回到>直到讀完路徑欄
  299. End Sub

  300. Sub GetPropNames()
  301. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  302. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  303. Dim vCfgNameArr As Object
  304. Dim vCfgName As Object
  305. Dim swCfg As SwDMConfiguration '14
  306. Dim nPropType As Long
  307. Dim PropList() As String
  308. ReDim PropList(0)
  309. PropList(0) = ""
  310. Dim intChoice As Integer
  311. Dim FilePathName As String
  312. Dim i As Integer
  313. HeaderRow = 2
  314. RowNumber = 3
  315. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  316. PropColumn = 4
  317. PropName = Cells(HeaderRow, PropColumn)
  318. While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完路徑欄
  319.     ReDim Preserve PropList(PropColumn - 3)
  320.     PropList(PropColumn - 3) = PropName
  321.     PropColumn = PropColumn + 1 '下一列
  322.     PropName = Cells(HeaderRow, PropColumn)
  323. Wend
  324. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
  325.     FileName = Cells(RowNumber, 2)
  326.     FileExtname = UCase(Right(Cells(RowNumber, 2), 6))
  327.     If "SLDPRT" = FileExtname Then swFileTYpe = 1
  328.     If "SLDASM" = FileExtname Then swFileTYpe = 2
  329.     If "SLDDRW" = FileExtname Then swFileTYpe = 3
  330.     Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟
  331.     If Not swDoc Is Nothing Then '排除無效檔案
  332.         swConfigName = Cells(RowNumber, 3)
  333.         If swConfigName = "" Or swConfigName = 0 Then
  334.             vCustPropNameArr = swDoc.GetCustomPropertyNames
  335.             If TypeName(vCustPropNameArr) = "String()" Then
  336.                  For Each vCustPropName In vCustPropNameArr
  337.                      InList = False
  338.                      For Each PropItem In PropList
  339.                         If vCustPropName = PropItem Then InList = True
  340.                      Next
  341.                      If Not InList Then
  342.                         ReDim Preserve PropList(UBound(PropList) + 1)
  343.                         PropList(UBound(PropList)) = vCustPropName
  344.                      End If
  345.                 Next
  346.             End If
  347.         Else
  348.             Set swCfgMgr = swDoc.ConfigurationManager
  349.             swConfigNames = swCfgMgr.GetConfigurationNames
  350.             For Each swConfigName In swConfigNames
  351.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  352.                 vCustPropNameArr = swCfg.GetCustomPropertyNames
  353.                 If TypeName(vCustPropNameArr) = "String()" Then
  354.                      For Each vCustPropName In vCustPropNameArr
  355.                          InList = False
  356.                          For Each PropItem In PropList
  357.                             If vCustPropName = PropItem Then InList = True
  358.                          Next
  359.                          If Not InList Then
  360.                             ReDim Preserve PropList(UBound(PropList) + 1)
  361.                             PropList(UBound(PropList)) = vCustPropName
  362.                          End If
  363.                     Next
  364.                 End If
  365.             Next
  366.         End If 'If swConfigName = "" Or swConfigName = 0
  367.         swDoc.CloseDoc '關閉檔案
  368.         Cells(RowNumber, 1).Interior.Color = RGB(200, 200, 255)
  369.     End If ''If Not swDoc Is Nothing
  370.     RowNumber = RowNumber + 1 '下一列
  371.     PathName = Cells(RowNumber, 1)
  372. Wend '回到>直到讀完路徑欄
  373. PropHeading = 4
  374. For i = 1 To UBound(PropList) '- 1
  375.     Cells(HeaderRow, PropHeading) = PropList(i)
  376.     Cells(HeaderRow, PropHeading).Font.Bold = True
  377.     PropHeading = PropHeading + 1
  378. Next
  379. End Sub

複製代碼
 樓主| 發表於 2014/10/31 22:15:17 | 顯示全部樓層
如果已經用上了SW2015,又有SW2015-SWDM-API的許可號碼,就可以按以上程式碼製作Excel表格。
發表於 2014/10/31 22:17:19 來自手機 | 顯示全部樓層
報告悶大,那我可以用^_^
發表於 2014/11/2 21:35:53 | 顯示全部樓層
感謝燜大無私分享,
當單一檔案組態數目讀取超過22個時,
就出現"程序呼叫或引數不正確",
是程式限制住了嗎?

 樓主| 發表於 2014/11/2 23:12:15 | 顯示全部樓層
lungni 發表於 2014/11/2 21:35
感謝燜大無私分享,
當單一檔案組態數目讀取超過22個時,
就出現"程序呼叫或引數不正確",

謝謝提醒,剛試過並找到原因,就是模型組態儲存格的漸深顏色,多於22個黑無可黑了,出現錯誤,現正修正,盡快補上。
 樓主| 發表於 2014/11/2 23:54:07 | 顯示全部樓層
gt.adan 發表於 2014/10/31 22:17
報告悶大,那我可以用^_^

阿丹請注意,110樓的代碼有BUG,幸得113樓 lungn 兄提醒,瀏覽檔案的巨集要更正,見以下附件及程式碼:

  1. Sub BrowseFiles()
  2. Range("A3").Activate
  3. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  4. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  5. Dim vCfgNameArr As Object
  6. Dim vCfgName As Object
  7. Dim swCfg As SwDMConfiguration '14
  8. Dim nPropType As Long
  9. Dim PropList() As String
  10. ReDim PropList(0)
  11. PropList(0) = ""
  12. Dim intChoice As Integer
  13. Dim FilePathName As String
  14. Dim i As Integer
  15. HeaderRow = 2
  16. RowNumber = 3
  17. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  18. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
  19.     RowNumber = RowNumber + 1 '下一列
  20.     PathName = Cells(RowNumber, 1)
  21. Wend '回到>直到讀完路徑欄
  22. Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
  23. Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
  24. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Part", "*.SLDPRT" '設定檔案類型
  25. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Part with Configs", "*.SLDPRT" '設定檔案類型
  26. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Asm", "*.SLDASM" '設定檔案類型
  27. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Asm with Configs", "*.SLDASM" '設定檔案類型
  28. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "SW Drawing", "*.SLDDRW" '設定檔案類型
  29. If Cells(1, 1) = 1 Or Cells(1, 1) = 2 Or Cells(1, 1) = 3 Or Cells(1, 1) = 4 Or Cells(1, 1) = 5 Then
  30.     Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
  31. End If
  32. If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
  33. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框

  34. If intChoice <> 0 Then '判斷有否點選檔案
  35.     RowCount = 1
  36.     swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
  37.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
  38.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
  39.         FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
  40.         FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
  41.         FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
  42.         If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
  43.             Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  44.             Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  45.             RowCount = RowCount + 1
  46.         End If
  47.         If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
  48.             Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
  49.             If Not swDoc Is Nothing Then '排除無效檔案
  50.                 Set swCfgMgr = swDoc.ConfigurationManager
  51.                 swConfigNames = swCfgMgr.GetConfigurationNames
  52.                 ConfigColor = 200
  53.                 For Each swConfigName In swConfigNames
  54.                     Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  55.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  56.                     If TypeName(vCustPropNameArr) = "String()" Then
  57.                          For Each vCustPropName In vCustPropNameArr
  58.                              InList = False
  59.                              For Each PropItem In PropList
  60.                                 If vCustPropName = PropItem Then InList = True
  61.                              Next
  62.                              If Not InList Then
  63.                                 ReDim Preserve PropList(UBound(PropList) + 1)
  64.                                 PropList(UBound(PropList)) = vCustPropName
  65.                              End If
  66.                         Next
  67.                     End If
  68.                     Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  69.                     Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  70.                     Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
  71.                     Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(ConfigColor, ConfigColor, ConfigColor)
  72.                     If ConfigColor < 100 Then Cells(RowCount + RowNumber - 1, 3).Font.ThemeColor = xlThemeColorDark1
  73.                     If ConfigColor > 20 Then ConfigColor = ConfigColor - 10
  74.                     RowCount = RowCount + 1
  75.                 Next
  76.                 swDoc.CloseDoc '關閉檔案
  77.             End If '排除無效檔案<完>
  78.         End If ''過濾器是2或4<完>
  79.     Next i '逐一讀取所選檔案<完>
  80. End If '判斷有否點選檔案<完>
  81. End Sub
複製代碼

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/11/7 14:16:53 | 顯示全部樓層
Francis 發表於 2014/11/2 23:54
阿丹請注意,110樓的代碼有BUG,幸得113樓 lungn 兄提醒,瀏覽檔案的巨集要更正,見以下附件及程式碼:

...

回覆悶哥,時隔數日,阿丹終於有時間安裝 2015~~
取得2015 SWDM 許可碼後,套入悶哥無私分享的代碼,加入引用後,執行成功!
話不多說,直接上圖~



本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2014/11/7 14:53:27 | 顯示全部樓層
感念悶大無私教學及分享,將此「外部批次修改屬性」代碼奉上。
原代碼已加密,請各位先進安心服用,享受悶大給大家帶來的便利及秒殺的快感!
再次謝謝悶哥的分享!





本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
西西巴 該用戶已被刪除
發表於 2014/12/17 12:45:17 | 顯示全部樓層
gt.adan 發表於 2014/10/31 22:17
報告悶大,那我可以用^_^

请问一下丹大SW2015-SWDM-API的許可號碼怎么获取啊,我用的是盗版的是不是就不能获取了啊
西西巴 該用戶已被刪除
發表於 2014/12/17 14:50:38 | 顯示全部樓層
gt.adan 發表於 2014/11/7 14:53
感念悶大無私教學及分享,將此「外部批次修改屬性」代碼奉上。
原代碼已加密,請各位先進安心服用,享受悶 ...

我以为要swdm许可码的,原来是直接可以用的啊,谢谢啦
發表於 2014/12/26 19:09:09 | 顯示全部樓層
我用的Excel的版本為2003,SolidWorks是2012版
在執行SWDM-API時會出現問題而無法用,我是用最新的SWDM-API-4版,執行SW-API也一樣無法用
按Browse Files時會出現以下圖片的錯誤訊息,按其他也是一樣
不知是哪裡出問題?會不會是Excel的版本太舊?
抱歉,小弟對VBA完全不懂,煩請個位大大指導一下,謝謝
第二張圖是按了執行巨集後的畫面

第三張圖是執行SwRename-En巨集(Excel 批次修改SolidWorks檔案名稱),卻可以執行

在CAX論壇也有人有同樣問題,
我的電腦作業系統是WINXP,安裝在D槽,

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
 樓主| 發表於 2015/9/17 19:52:56 | 顯示全部樓層
lungni 發表於 2014/11/2 21:35
感謝燜大無私分享,
當單一檔案組態數目讀取超過22個時,
就出現"程序呼叫或引數不正確",

回顧一下這個『眾人在問題表面高速滑行』的帖子,
並再一次感謝 lungni兄的提醒,讓希望深入討論的悶人不會過於寂寞。
發表於 2015/9/18 09:27:21 | 顯示全部樓層
經過悶大的回覆,我才知道有這個好用的神器
感謝丹大及悶大,解決了我的困難!
發表於 2015/11/27 13:16:32 | 顯示全部樓層
Francis 發表於 2014/10/29 01:12
來了
用法參考以下帖子#7樓
http://www.solidworks.org.tw/forum.php?mod=redirect&goto=findpost&ptid=26 ...

您好,能提一下解压密码吗,我急需这个功能来批量修改图号,谢谢
發表於 2015/11/30 17:24:47 | 顯示全部樓層
Francis 發表於 2014/11/2 23:54
阿丹請注意,110樓的代碼有BUG,幸得113樓 lungn 兄提醒,瀏覽檔案的巨集要更正,見以下附件及程式碼:

...

谢谢闷大的分享,感觉非常好用,帮我解决了困扰很久的难题(本人对API一窍不通,只能拿来主义了)。
“Browse File”能直接打开上一次打开的文件夹会更好,例如solidworks打开文件时检索的一般都是上一次打开的文件夹。另外还想请教闷大图片中的问题,望能帮小弟解决,感激不尽。

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2015/11/30 17:39:07 | 顯示全部樓層
忘川啊 發表於 2015/11/30 17:24
谢谢闷大的分享,感觉非常好用,帮我解决了困扰很久的难题(本人对API一窍不通,只能拿来主义了)。
“Br ...

你這個做法是自行統計數量輸入,那不如就輸入到標註,不需要做屬性吧。

關於統計孔數,悶哥有更好的方法。

發表於 2015/12/1 09:32:37 | 顯示全部樓層
臭臉翔 發表於 2015/11/30 17:39
你這個做法是自行統計數量輸入,那不如就輸入到標註,不需要做屬性吧。

關於統計孔數,悶哥有更好的方法 ...

我图中文件属性的孔数只是举个例子,实际上我要用方程式来驱动的,不是手动输入,我其实想问问尺寸文本框是否可以链接属性而已(要是可以就比较简单些)
焖大统计孔数的方法能说说吗(我没看过)
發表於 2015/12/1 09:56:17 | 顯示全部樓層
大鹿 發表於 2015/11/30 21:26
當然可以記錄上次的開啟位置,只是仁兄視而不見而已。
在83樓已經有教學,說明設定了開啟預設位置的方法 ...

谢谢您的回复,不过我是真心不会,我还想问一个小问题:文件类此中能增加“带有工程图的零件”这种类型么?因为文件夹中经常会含有大量标准件(不需要更改其文件属性),如果有应该能提高搜索效率
發表於 2015/12/1 10:01:35 | 顯示全部樓層
臭臉翔 發表於 2015/11/30 17:39
你這個做法是自行統計數量輸入,那不如就輸入到標註,不需要做屬性吧。

關於統計孔數,悶哥有更好的方法 ...

点击进去后,提示网页无法访问
發表於 2015/12/7 11:42:48 | 顯示全部樓層
請問我使用SW2015版,excel 2013. 在執行SWDM-API-2015--Browse Files--Get Property Names--Read Properties Value--輸入數據--Write Properties Value--Delete Properties--關閉excel然後再開啟執行SWDM-API-2015--Browse Files--Get Property Names--Read Properties Value,Read Properties Value無法再自動顯示屬性.是否有方法解決??還是我操作錯誤?



 樓主| 發表於 2015/12/14 14:25:26 | 顯示全部樓層
樓上已經把所有屬性都刪除了,當然再沒有屬性可以讀進來,而且被刪除的屬性也無法挽回的。
發表於 2015/12/16 11:51:22 | 顯示全部樓層
俺來亂入下。
好像solidworks文檔內部信息是分類儲存的。幾何信息,文本信息都是分門別類儲存在相應的地方。所以相對來說呼叫文本信息會容易點,甚至不需要電腦裡有solidworks軟體。

瞎整的,偶也忘啦,哪裡看到的啦。不知對錯。
 樓主| 發表於 2016/4/27 18:46:25 | 顯示全部樓層
在另一個類似的討論『利用 Excel 批量修改SW檔案屬性 (無需 SWDM-API 許可號碼)』,在45樓 DaveChan 提出了一些見解,對這個高速版有異曲同工之妙。
http://www.solidworks.org.tw/forum.php?mod=redirect&goto=findpost&ptid=26079&pid=240123&fromuid=104141

DaveChan提及的函數GetCustomPropertyValues,非常有用,可同時獲取『表達式』及『評估值』,這樣,就可以借助Excel的註解顯示『評估值』,讓此工具可反映實況。
修改程式碼的做法:
1. 注意主函數,5以上方可獲取『評估值』。
2. 加入聲明
3. 插入程式碼:
  1.                                 PropValue = swDoc.GetCustomPropertyValues(PropName, swDmCustomInfoText, linkedTo)
  2.                                 Cells(RowNumber, ColumnNumber).ClearComments
  3.                                 Cells(RowNumber, ColumnNumber).AddComment
  4.                                 Cells(RowNumber, ColumnNumber).Comment.Visible = False
  5.                                 Cells(RowNumber, ColumnNumber).Comment.Text Text:="評估值:" & Chr(10) & PropValue
複製代碼
4. 插入程式碼:
  1.                                 Cells(RowNumber, ColumnNumber).ClearComments
  2.                                 Cells(RowNumber, ColumnNumber).AddComment
  3.                                 Cells(RowNumber, ColumnNumber).Comment.Visible = False
  4.                                 Cells(RowNumber, ColumnNumber).Comment.Text Text:="評估值:" & Chr(10) & PropValue
複製代碼
具體位置見下圖:

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x
發表於 2016/4/27 18:50:41 | 顯示全部樓層
继续讨论是否可以读取属性为『数式』还是『结果』無需 SWDM-API 許可號碼版本已经完成
http://www.solidworks.org.tw/forum.php?mod=viewthread&tid=26079


请问闷大,还是跟SW API版本一样,读取评估值的API已找到,但是达不到效果,代码如下


  1. 'PropValue = swDoc.GetCustomProperty(PropName, swDmCustomInfoText) '取消此句

  2. Dim linkedTo As String
  3. PropValue = swDoc.GetCustomPropertyValues(PropName, swDmCustomInfoText, linkedTo) '替换成此句

  4. Cells(RowNumber, ColumnNumber) = PropValue
複製代碼


發表於 2016/4/27 18:52:00 | 顯示全部樓層
Francis 發表於 2016/4/27 18:46
在另一個類似的討論『利用 Excel 批量修改SW檔案屬性 (無需 SWDM-API 許可號碼)』,在45樓 DaveChan 提出了 ...

这么快就有结果贴出来了,谢谢
您需要登錄後才可以回帖 登錄 | 註冊

本版積分規則

論壇統計|手機版上論壇|論壇來自幾何科技 論壇架構版次 20240312

GMT+8, 2024/3/29 03:07 , Processed in 0.163373 second(s), 21 queries .

Powered by Discuz! X3.4 Licensed

© 2001-2023 Discuz! Team.

快速回復 返回頂部 返回列表