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

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

晕，我是不是点了“点评”按钮了？用点评功能可能看上去有点不尊重您了。抱歉了。

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

您好。
试用你的代码，现在试用的结果如下：
第一：代码中

1.   If "SLDPRT" = UCase(Left(RefModelName, 6)) Then '分辨參考檔案的類型
   
2.                 RefModelTYpe = 1 '這是零件
   
3.             Else
   
4.                 RefModelTYpe = 2 '這是組合件

复制代码

这一段应该改为

1. If "SLDPRT" = UCase(Right(RefModelName, 6)) Then '分辨參考檔案的類型
   
2.                 RefModelTYpe = 1 '這是零件
   
3.             Else
   
4.                 RefModelTYpe = 2 '這是組合件

复制代码

修改后才能正确抓取后缀的几位字母以识别为零或者装配体；
第二：您给的这段代码，获取的还是在“自定义”选项卡上的属性而非“配置特定选项卡”中的属性。
今天晚上我熬夜弄这个东西，看来要再另想办法找出正确的代码来了。
仍然感谢你。

dreamsboy 发表于 2016-11-5 01:55
您好。
试用你的代码，现在试用的结果如下：
第一：代码中

1.这段代码确实错了，我是按照你提供的代码更改的，没注意到，但是很奇怪，我使用却并无异常
2.代码确实是读取的配置特定中的属性，确认是读取下图中的属性，无误

我重贴一下代码

1. Sub ReadModelPrpInSlddrw()
   
2. Dim swDM As SwDMApplication
   
3. Dim swDoc As SwDMDocument12
   
4. Dim swModel As SwDMDocument12
   
5. Dim dmSearchOpt As SwDMSearchOption
   
6. Dim objClassfac As SwDMClassFactory
   
7. Dim mOpenErrors As SwDmDocumentOpenError
   
8. Dim swCfgMgr As SwDMConfigurationMgr
   
9. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
   
10. SWDMLicenseKey = InputBox("輸入許可證密碼")
    
11. If SWDMLicenseKey = "" Then Exit Sub
    
12. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
    
13. HeaderRoll = 2
    
14. RollNumber = HeaderRoll + 1
    
15. PathName = ActiveSheet.Cells(RollNumber, 1) '讀取第一個路徑的值
    
16. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄
    
17.     FileName = ActiveSheet.Cells(RollNumber, 2)
    
18.     Set swDoc = swDM.GetDocument(PathName & FileName, 3, False, mOpenErrors)  '開啟工程圖
    
19.     If Not swDoc Is Nothing Then
    
20.         RefModelNames = swDoc.GetAllExternalReferences(dmSearchOpt) '獲取參考檔案名稱
    
21.         If Not TypeName(RefModelNames) = "Empty" Then '過濾沒有參考檔案
    
22.             Cells(RollNumber, 2).Interior.ColorIndex = 8
    
23.             RefModelName = RefModelNames(0) '獲取第一個參考檔案的名稱
    
24.             If "SLDPRT" = UCase(Right(RefModelName, 6)) Then '分辨參考檔案的類型
    
25.                 RefModelTYpe = 1 '這是零件
    
26.             Else
    
27.                 RefModelTYpe = 2 '這是組合件
    
28.             End If
    
29.             Set swModel = swDM.GetDocument(RefModelName, RefModelTYpe, False, mOpenErrors) '開啟
    
30.             Set swCfgMgr = swModel.ConfigurationManager
    
31.             ColumnNumber = 3
    
32.             PropName = Cells(HeaderRoll, ColumnNumber)
    
33.             While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到讀完表頭
    
34.                 swConfigName = swCfgMgr.GetActiveConfigurationName
    
35.                 Dim swCfg As SwDMConfiguration12
    
36.                 Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
    
37.                 PropNames = swCfg.GetCustomPropertyNames '獲取模型內所有屬性的名稱
    
38.                 HasPropName = False
    
39.                 If Not IsEmpty(PropNames) Then
    
40.                     For i = 0 To UBound(PropNames) '核對書否存在表單上的屬性名稱
    
41.                         If UCase(PropNames(i)) = UCase(PropName) Then HasPropName = True
    
42.                     Next
    
43.                 End If
    
44.                 If HasPropName Then
    
45.                     PropValue = swCfg.GetCustomProperty(PropName, swDmCustomInfoText) '獲取參考檔案的屬性
    
46.                     Cells(RollNumber, ColumnNumber) = PropValue '寫入屬性到表格
    
47.                 Else
    
48.                     Cells(RollNumber, ColumnNumber) = "-----" '寫入代表不存在屬性的字符
    
49.                 End If
    
50.                 ColumnNumber = ColumnNumber + 1 '下一欄
    
51.                 PropName = ActiveSheet.Cells(HeaderRoll, ColumnNumber)
    
52.             Wend '回到>直到讀完表頭
    
53.             swModel.CloseDoc '關閉參考檔案
    
54.             Cells(RollNumber, ColumnNumber) = RefModelName '寫入參考檔案名稱到表格到行末
    
55.             End If
    
56.         swDoc.CloseDoc '關閉工程圖
    
57.     End If
    
58.     RollNumber = RollNumber + 1 '下一列
    
59.     PathName = ActiveSheet.Cells(RollNumber, 1)
    
60. Wend '回到>直到讀完路徑欄
    
61. End Sub

复制代码

你说的问题可否截图说明一下

DaveChan 发表于 2016-11-5 08:23
1.这段代码确实错了，我是按照你提供的代码更改的，没注意到，但是很奇怪，我使用却并无异常
2.代码确实 ...

现在测试正常了。
请问大师，知不知道在swdm中，用什么语句读取到属性的评估值而不是读取到那一段代码？
谢谢

dreamsboy 发表于 2016-11-5 08:59
现在测试正常了。
请问大师，知不知道在swdm中，用什么语句读取到属性的评估值而不是读取到那一段代码？ ...

获取评估值代码

1. GetCustomPropertyValues

复制代码

dreamsboy 发表于 2016-11-5 08:59
现在测试正常了。
请问大师，知不知道在swdm中，用什么语句读取到属性的评估值而不是读取到那一段代码？ ...

获取评估值完整代码(配置特定属性中)

1. Sub ReadModelPrpInSlddrw()
   
2. Dim swDM As SwDMApplication
   
3. Dim swDoc As SwDMDocument12
   
4. Dim swModel As SwDMDocument12

复制代码

DaveChan 发表于 2016-11-5 09:15
获取评估值完整代码(配置特定属性中)

谢谢。我刚按闷大的大法修改了一下，发现运行出错。原来是图片上的那个14只能改成12就可以了。不知道这个是不是因为版本的关系？

DaveChan 发表于 2016-11-5 09:15
获取评估值完整代码(配置特定属性中)

真是太感谢您了。
接下来我就是要找到从工程图直接打开工程图所引用的零件的配置并读取这个配置的属性的代码了。
我是VBA小白，代码都只能慢慢的改慢慢的试。幸亏有你们这些大师不吝指点了。万分感谢了。

dreamsboy 发表于 2016-11-5 09:20
谢谢。我刚按闷大的大法修改了一下，发现运行出错。原来是图片上的那个14只能改成12就可以了。不知道这个 ...

只要是5以上都能获取，具体数值根据自己的版本来

DaveChan 发表于 2016-11-5 09:27
只要是5以上都能获取

学到了。
学疏才浅，不知道这些后缀数字到底有什么不同，所以前面硬搬闷大的那个“14”进来，运行出错。乱改了一个小点的数字，改成“12”竟然就没报错了。
大师能不能指点一下，这些不同的数字到底有什么不同的含义和用法呢？看了很多宏，都有这种用不同的数字后缀的情况，搞晕头了都不知道为什么要用这些不同的数字。