找回密码 注册 QQ登录
一站式解决方案

iCAx开思网

CAD/CAM/CAE/设计/模具 高清视频【积分说明】如何快速获得积分?快速3D打印 手板模型CNC加工服务在线3D打印服务,上传模型,自动报价
查看: 3464|回复: 5
打印 上一主题 下一主题

[求助] excel VBA 批量更改solidworks 属性的问题

[复制链接]
跳转到指定楼层
1
发表于 2017-7-18 13:08:21 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
现在的问题是 :在下面的代码的空白处加什么代码。可以达到图片的效果。就是在打开装配体的时候,自动遍历装配下的零件和数量 并自动缩进
  1. Dim swDM As SwDMApplication
  2. Dim swDoc As SwDMDocument12
  3. Dim mOpenErrors As SwDmDocumentOpenError
  4. Dim swCfgMgr As SwDMConfigurationMgr
  5. Dim objClassfac As SwDMClassFactory
  6. Dim vCustPropNameArr As Variant
  7. Const SWDMLicenseKey = ""


  8. Sub 打开文件()
  9. Range("A3").Activate
  10. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
  11. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
  12. Dim vCfgNameArr As Object
  13. Dim vCfgName As Object
  14. Dim swCfg As SwDMConfiguration '14
  15. Dim nPropType As Long
  16. Dim PropList() As String
  17. ReDim PropList(0)
  18. PropList(0) = ""
  19. Dim intChoice As Integer
  20. Dim FilePathName As String
  21. Dim i As Integer
  22. HeaderRow = 2
  23. RowNumber = 3
  24. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
  25. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
  26.     RowNumber = RowNumber + 1 '下一列
  27.     PathName = Cells(RowNumber, 1)
  28. Wend '回到>直到讀完路徑欄
  29. Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
  30. Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
  31. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型
  32. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
  33. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
  34. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
  35. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
  36. 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
  37.     Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
  38. End If
  39. If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
  40. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框

  41. If intChoice <> 0 Then '判斷有否點選檔案
  42.     RowCount = 1
  43.     swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
  44.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
  45.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
  46.         FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
  47.         FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
  48.         FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
  49.         If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
  50.             Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  51.             Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  52.             RowCount = RowCount + 1
  53.         End If
  54.         If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
  55.             Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
  56.             If Not swDoc Is Nothing Then '排除無效檔案
  57.                 Set swCfgMgr = swDoc.ConfigurationManager
  58.                 swConfigNames = swCfgMgr.GetConfigurationNames
  59.                
  60.                 For Each swConfigName In swConfigNames
  61.                     Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
  62.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
  63.                     If TypeName(vCustPropNameArr) = "String()" Then










  64.                     End If
  65.                     Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
  66.                     Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
  67.                     Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
  68.                     Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)

  69.                     RowCount = RowCount + 1
  70.                 Next
  71.                 swDoc.CloseDoc '關閉檔案
  72.             End If '排除無效檔案<完>
  73.         End If ''過濾器是2或4<完>
  74.     Next i '逐一讀取所選檔案<完>
  75. End If '判斷有否點選檔案<完>
  76. End Sub

复制代码


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享淘帖 赞一下!赞一下!
2
发表于 2017-7-18 18:20:22 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
3
 楼主| 发表于 2017-7-19 12:43:36 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
4
发表于 2017-7-19 13:12:26 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
5
 楼主| 发表于 2017-7-20 11:41:35 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
6
发表于 2018-6-30 01:10:45 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

3D打印手板模型快速制作服务,在线报价下单!

QQ 咨询|手机版|联系我们|iCAx开思网  

GMT+8, 2024-11-6 08:02 , Processed in 0.023784 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.3

© 2002-2024 www.iCAx.org

快速回复 返回顶部 返回列表