|
參考
SWP文件
批量自訂屬性複製到配置屬性.rar
(11.01 KB, 下载次数: 341)
應用例如: https://www.swbbsc.com/forum.php? ... 3561&extra=page%3D1
- '
- ' 在某文件路徑下批量開零件及裝配件取自訂屬性複製到[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]特定
- ' sc liang 2018/6/20
- ' 測試版 2012 sp4
- '
- '~~~ Main ~~~
- Dim swApp As SldWorks.SldWorks
- Dim swModel As SldWorks.ModelDoc
- Dim Part As Object
- Dim sFileName As String
- Dim path As String
- Dim Tpye_ As String
- Dim nErrors As Long
- Dim nWarnings As Long
- '~~~ CopyToConfiguration ~~
- 'Dim swModel As SldWorks.ModelDoc2
- Dim swCustPrpMgr As SldWorks.CustomPropertyManager
- Dim swConfCustPrpMgr As SldWorks.CustomPropertyManager
- Sub Main()
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
- path = InputBox("Enter a folder path containing any Solidworks files (For example '' C:\test\ '' )", "Parts path location", "C:\test\") '鍵入存檔路徑
- sFileName = Dir(path & "*.sld*") '取出SW檔
-
- '循環開檔
- Do Until sFileName = ""
- Type_ = Right(sFileName, 3) '取得SW文件擴展名後三位
- Select Case Type_
- '開零件檔
- Case "PRT"
- Set swModel = swApp.OpenDoc6(path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings) '開零件檔
- CopyToConfiguration
- '開組件檔
- Case "ASM"
- Set swModel = swApp.OpenDoc6(path + sFileName, swDocASSEMBLY, swOpenDocOptions_Silent, "", nErrors, nWarnings) '開組件檔
- CopyToConfiguration
- End Select
- 'Set Part = swApp.ActiveDoc
- If Type_ <> "DRW" Then
- swModel.Save '存檔
- swApp.CloseDoc swModel.GetTitle '關檔
- End If
- Set swModel = Nothing
- sFileName = Dir '同路徑取出下個SW文件檔名
- Loop
- End Sub
- '~~~ 零件及組件之自訂屬性複製到[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]特定
- Sub CopyToConfiguration()
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
-
- If Not swModel Is Nothing Then
- Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
- Dim vNames As Variant
- Dim vTypes As Variant
- Dim vValues As Variant
- swCustPrpMgr.GetAll vNames, vTypes, vValues
- Dim activeConfName As String
- activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name
- Set swConfCustPrpMgr = swModel.Extension.CustomPropertyManager(activeConfName)
- Dim i As Integer
-
- For i = 0 To UBound(vNames)
- swConfCustPrpMgr.Add2 vNames(i), vTypes(i), vValues(i)
- 'swConfCustPrpMgr.Set vNames(i), vValues(i)
- Next
-
- Else
- MsgBox "Please open part or assembly"
- End If
- End Sub
复制代码
|
|