|
1.这段代码确实错了,我是按照你提供的代码更改的,没注意到,但是很奇怪,我使用却并无异常
2.代码确实是读取的配置特定中的属性,确认是读取下图中的属性,无误
我重贴一下代码
Sub ReadModelPrpInSlddrw()
Dim swDM As SwDMApplication
Dim swDoc As SwDMDocument12
Dim swModel As SwDMDocument12
Dim dmSearchOpt As SwDMSearchOption
Dim objClassfac As SwDMClassFactory
Dim mOpenErrors As SwDmDocumentOpenError
Dim swCfgMgr As SwDMConfigurationMgr
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
SWDMLicenseKey = InputBox("輸入許可證密碼")
If SWDMLicenseKey = "" Then Exit Sub
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
HeaderRoll = 2
RollNumber = HeaderRoll + 1
PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
FileName = ActiveSheet.Cells(RollNumber, 2)
Set swDoc = swDM.GetDocument(PathName & FileName, 3, False, mOpenErrors) '開啟工程圖
If Not swDoc Is Nothing Then
RefModelNames = swDoc.GetAllExternalReferences(dmSearchOpt) '獲取參考檔案名稱
If Not TypeName(RefModelNames) = "Empty" Then '過濾沒有參考檔案
Cells(RollNumber, 2).Interior.ColorIndex = 8
RefModelName = RefModelNames(0) '獲取第一個參考檔案的名稱
If "SLDPRT" = UCase(Right(RefModelName, 6)) Then '分辨參考檔案的類型
RefModelTYpe = 1 '這是零件
Else
RefModelTYpe = 2 '這是組合件
End If
Set swModel = swDM.GetDocument(RefModelName, RefModelTYpe, False, mOpenErrors) '開啟
Set swCfgMgr = swModel.ConfigurationManager
ColumnNumber = 3
PropName = Cells(HeaderRoll, ColumnNumber)
While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
swConfigName = swCfgMgr.GetActiveConfigurationName
Dim swCfg As SwDMConfiguration12
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
PropNames = swCfg.GetCustomPropertyNames '獲取模型內所有屬性的名稱
HasPropName = False
If Not IsEmpty(PropNames) Then
For i = 0 To UBound(PropNames) '核對書否存在表單上的屬性名稱
If UCase(PropNames(i)) = UCase(PropName) Then HasPropName = True
Next
End If
If HasPropName Then
PropValue = swCfg.GetCustomProperty(PropName, swDmCustomInfoText) '獲取參考檔案的屬性
Cells(RollNumber, ColumnNumber) = PropValue '寫入屬性到表格
Else
Cells(RollNumber, ColumnNumber) = "-----" '寫入代表不存在屬性的字符
End If
ColumnNumber = ColumnNumber + 1 '下一欄
PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
Wend '回到>直到讀完表頭
swModel.CloseDoc '關閉參考檔案
Cells(RollNumber, ColumnNumber) = RefModelName '寫入參考檔案名稱到表格到行末
End If
swDoc.CloseDoc '關閉工程圖
End If
RollNumber = RollNumber + 1 '下一列
PathName = ActiveSheet.Cells(RollNumber, 1)
Wend '回到>直到讀完路徑欄
End Sub
复制代码
你说的问题可否截图说明一下 |
|