烦请闷大、丹大指教两个SWDM-API使用中的代码问题

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

复制代码

闷大，以上代码为您在几何专门论坛 https://www.SOLIDWORKS.org.tw/forum.php?mod=viewthread&tid=26031&extra=page%3D1&page=2 这帖的51楼贴出来的一段代码。我现在想做一个EXCEL版的SWDM-API文件，在参考使用、修改这些代码，在此过程中碰到两个问题，百度求助没找到能解决我的问题的资料，SWDM-API帮助中又没有VBA的实例，有个VB.NET的实例，但复制到VBA里想看看原理时一运行就出错，可能是代码兼容性问题。没办法只能向闷大您求教了。问题的情况是：
一：在您51楼的读取工程图中参考的零部件的属性中，不知道怎样修改代码可以让获取得到的属性值是工程图中关联的零部件件的配置特定的属性而不是自定义属性选项卡上的属性？
二：SWDM-API打开工程图后，不知道用什么代码获取这个工程图的图纸格式的大小？不管获得的是类似A4 A3这样的结果还是类似于“297mm*210mm"这样的结果，当然最好是能输出A4 A3这种的，我需要输出的是这个值。（知识匮乏，不知道应该分别怎样称呼这两种格式，是否其一是“图纸格式”其一是“图幅”？）SW-API获取图页图幅属性的代码为            vsheetprops = swCurrentSheet.GetProperties
但是我不知道在SWDM-API中读取图页图幅属性的代码。
恳请闷大指点，谢谢。
也请大能 丹大以及梁大等一众高人指点。谢谢。

我来帮你解答第一个问题吧
1.SWDM-API我不能获取到工程图模型的配置，所以只写了获取活动配置，
暂时不知道怎么获取工程图模型引用的配置，以下代码是获取活动配置的属性(一般情况下是"默认"配置)
由于不是专业写代码的，有不对的地方，还望指正

1. Sub ReadModelPrpInSlddrw()
   
2. Dim swModel As SwDMDocument12
   
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.             Set swCfgMgr = swModel.ConfigurationManager
    
26.             ColumnNumber = 3
    
27.             PropName = Cells(HeaderRoll, ColumnNumber)
    
28.             While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
    
29.                 swConfigName = swCfgMgr.GetActiveConfigurationName
    
30.                 Dim swCfg As SwDMConfiguration12
    
31.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
    
32.                 PropNames = swCfg.GetCustomPropertyNames '獲取模型內所有屬性的名稱
    
33.                 HasPropName = False
    
34.                 If Not IsEmpty(PropNames) Then
    
35.                     For I = 0 To UBound(PropNames) '核對書否存在表單上的屬性名稱
    
36.                         If UCase(PropNames(I)) = UCase(PropName) Then HasPropName = True
    
37.                     Next
    
38.                 End If
    
39.                 If HasPropName Then
    
40.                     PropValue = swCfg.GetCustomProperty(PropName, swDmCustomInfoText) '獲取參考檔案的屬性
    
41.                     Cells(RollNumber, ColumnNumber) = PropValue '寫入屬性到表格
    
42.                 Else
    
43.                     Cells(RollNumber, ColumnNumber) = "-----" '寫入代表不存在屬性的字符
    
44.                 End If
    
45.                 ColumnNumber = ColumnNumber + 1 '下一欄
    
46.                 PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
    
47.             Wend '回到>直到讀完表頭
    
48.             swModel.CloseDoc '關閉參考檔案
    
49.             Cells(RollNumber, ColumnNumber) = RefModelName '寫入參考檔案名稱到表格到行末
    
50.             End If
    
51.         swDoc.CloseDoc '關閉工程圖
    
52.     End If
    
53.     RollNumber = RollNumber + 1 '下一列
    
54.     PathName = ActiveSheet.Cells(RollNumber, 1)
    
55. Wend '回到>直到讀完路徑欄
    
56. End Sub

复制代码

DaveChan 发表于 2016-11-4 18:53
我来帮你解答第一个问题吧
1.SWDM-API我不能获取到工程图模型的配置，所以只写了获取活动配置，
暂时不知 ...

谢谢老兄，我晚上熬夜研究学习下。谢谢。

dreamsboy 发表于 2016-11-4 20:06
谢谢老兄，我晚上熬夜研究学习下。谢谢。

第二个问题，如果工程图中有多张图纸，那么读取哪一张工程图的图页属性呢？

DaveChan 发表于 2016-11-4 20:18
第二个问题，如果工程图中有多张图纸，那么读取哪一张工程图的图页属性呢？

就读取第一张的就OK了。谢谢关注和帮助。

dreamsboy 发表于 2016-11-4 20:39
就读取第一张的就OK了。谢谢关注和帮助。

请测试

1. Sub GetFormatProp()
   
2. Dim swDoc As SwDMDocument14
   
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. RowCount = 1
    
12. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
    
13.     FileName = ActiveSheet.Cells(RollNumber, 2)
    
14.     Set swDoc = swDM.GetDocument(PathName & FileName, 3, False, mOpenErrors)  '開啟工程圖
    
15.     If Not swDoc Is Nothing Then
    
16.         Dim SheetNameVar As Variant
    
17.         Dim SheetCount As Long
    
18.         Dim SheetName As String
    
19.         Dim SheetNameCount As Integer
    
20.         Dim FormatName As String
    
21.         Dim Status1 As SwDocumentMgr.swSheetFormatPathResult
    
22.         Dim Status2 As SwDocumentMgr.swSheetPropertiesResult
    
23.         Dim FormatProp As Variant
    
24.         Dim para As Double
    
25.         SheetCount = swDoc.GetSheetCount
    
26.         SheetNameVar = swDoc.GetSheetNames
    
27.         SheetName = SheetNameVar(LBound(SheetNameVar))
    
28.         Status1 = swDoc.GetSheetFormatPath(SheetName, FormatName)
    
29.         Status2 = swDoc.GetSheetProperties(SheetName, FormatProp)
    
30.         ActiveSheet.Cells(RowCount + RollNumber - 1, 5) = SheetName
    
31.         ActiveSheet.Cells(RowCount + RollNumber - 1, 6) = FormatProp(1) * 1000 & "X" & FormatProp(2) * 1000
    
32.     End If
    
33.     swDoc.CloseDoc '關閉工程圖
    
34.     RollNumber = RollNumber + 1 '下一列
    
35.     PathName = ActiveSheet.Cells(RollNumber, 1)
    
36. Wend '回到>直到讀完路徑欄
    
37. End Sub
    

复制代码

DaveChan 发表于 2016-11-4 20:55
请测试

非常感谢。
其实这一步今天下午我在公司时已经解决得差不多了，是参考SW中自带的SWDM的帮助文件的实例做的，慢慢的修改，虽然最终也能达成我的需要了，但被我改得乱七八糟让人不忍直视了。谢谢您的大作，我还是放弃自己改的那些乱七八糟的代码，研究学习您这精简的代码吧。

dreamsboy 发表于 2016-11-4 21:01
非常感谢。
其实这一步今天下午我在公司时已经解决得差不多了，是参考SW中自带的SWDM的帮助文件的实例做 ...

刚才代码声明部分发现不对，有更改一点，还请重新复制测试

重贴完整代码

1. Sub GetFormatProp()
   
2. Dim swDM As SwDMApplication
   
3. Dim objClassfac As SwDMClassFactory
   
4. Dim mOpenErrors As SwDmDocumentOpenError
   
5. Dim swDoc As SwDMDocument14
   
6. Dim dmSearchOpt As SwDMSearchOption
   
7. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
   
8. SWDMLicenseKey = InputBox("輸入許可證密碼")
   
9. If SWDMLicenseKey = "" Then Exit Sub
   
10. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
    
11. HeaderRoll = 2
    
12. RollNumber = HeaderRoll + 1
    
13. PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
    
14. RowCount = 1
    
15. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
    
16.     FileName = ActiveSheet.Cells(RollNumber, 2)
    
17.     Set swDoc = swDM.GetDocument(PathName & FileName, 3, False, mOpenErrors)  '開啟工程圖
    
18.     If Not swDoc Is Nothing Then
    
19.         Dim SheetNameVar As Variant
    
20.         Dim SheetCount As Long
    
21.         Dim SheetName As String
    
22.         Dim SheetNameCount As Integer
    
23.         Dim FormatName As String
    
24.         Dim Status1 As SwDocumentMgr.swSheetFormatPathResult
    
25.         Dim Status2 As SwDocumentMgr.swSheetPropertiesResult
    
26.         Dim FormatProp As Variant
    
27.         Dim para As Double
    
28.         SheetCount = swDoc.GetSheetCount
    
29.         SheetNameVar = swDoc.GetSheetNames
    
30.         SheetName = SheetNameVar(LBound(SheetNameVar))
    
31.         Status1 = swDoc.GetSheetFormatPath(SheetName, FormatName)
    
32.         Status2 = swDoc.GetSheetProperties(SheetName, FormatProp)
    
33.         ActiveSheet.Cells(RowCount + RollNumber - 1, 5) = SheetName
    
34.         ActiveSheet.Cells(RowCount + RollNumber - 1, 6) = FormatProp(1) * 1000 & "X" & FormatProp(2) * 1000
    
35.     End If
    
36.     swDoc.CloseDoc '關閉工程圖
    
37.     RollNumber = RollNumber + 1 '下一列
    
38.     PathName = ActiveSheet.Cells(RollNumber, 1)
    
39. Wend '回到>直到讀完路徑欄
    
40. End Sub
    

复制代码

DaveChan 发表于 2016-11-4 21:13
重贴完整代码

好的。
刚才有点事在忙了会，才看到消息。
谢谢。