|
现在的问题是 :在下面的代码的空白处加什么代码。可以达到图片的效果。就是在打开装配体的时候,自动遍历装配下的零件和数量 并自动缩进- Dim swDM As SwDMApplication
- Dim swDoc As SwDMDocument12
- Dim mOpenErrors As SwDmDocumentOpenError
- Dim swCfgMgr As SwDMConfigurationMgr
- Dim objClassfac As SwDMClassFactory
- Dim vCustPropNameArr As Variant
- Const SWDMLicenseKey = ""
- Sub 打开文件()
- Range("A3").Activate
- Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
- Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
- Dim vCfgNameArr As Object
- Dim vCfgName As Object
- Dim swCfg As SwDMConfiguration '14
- Dim nPropType As Long
- Dim PropList() As String
- ReDim PropList(0)
- PropList(0) = ""
- Dim intChoice As Integer
- Dim FilePathName As String
- Dim i As Integer
- HeaderRow = 2
- RowNumber = 3
- PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
- While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
- RowNumber = RowNumber + 1 '下一列
- PathName = Cells(RowNumber, 1)
- Wend '回到>直到讀完路徑欄
- Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
- Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
- Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型
- Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
- Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
- Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
- Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
- 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
- Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
- End If
- If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
- intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
- If intChoice <> 0 Then '判斷有否點選檔案
- RowCount = 1
- swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
- For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
- FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
- FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
- FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
- FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
- If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
- Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
- Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
- RowCount = RowCount + 1
- End If
- If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
- Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
- If Not swDoc Is Nothing Then '排除無效檔案
- Set swCfgMgr = swDoc.ConfigurationManager
- swConfigNames = swCfgMgr.GetConfigurationNames
-
- For Each swConfigName In swConfigNames
- Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
- vCustPropNameArr = swCfg.GetCustomPropertyNames
- If TypeName(vCustPropNameArr) = "String()" Then
- End If
- Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
- Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
- Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
- Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)
- RowCount = RowCount + 1
- Next
- swDoc.CloseDoc '關閉檔案
- End If '排除無效檔案<完>
- End If ''過濾器是2或4<完>
- Next i '逐一讀取所選檔案<完>
- End If '判斷有否點選檔案<完>
- End Sub
复制代码
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|