SolidWorks專門論壇 SolidWorks forum

 找回密碼
 註冊
查看: 2113|回復: 9

EXCEL读取文档属性速度

[複製鏈接]
發表於 2019/11/22 10:49:18 | 顯示全部樓層 |閱讀模式
      咨询下各位通过VBA宏实现读取三维零件.PRT或者装配文件.asm格式的文档获取文档属性和写入文档属性时,涉及多个文档读写时感觉慢,读取59个零件的属性(零件号、名称)用了1分30秒,写入59个零件(零件号)属性用了4分钟,这个速度正常么?
      以下是读写的代码:
Sub ReadPrpExcel()  '读取文档属性
Set swApp = CreateObject("SldWorks.Application") '启动SW
ReadFilesCount = 0
HeaderRow = 2
RowNumber = HeaderRow + 1
PathName = Cells(RowNumber, 1) '读取第一个路径的值
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到读完路径栏
    Filename = Cells(RowNumber, 2)
    If UCase(Right(Filename, 3)) = "PRT" Then swFileTYpe = 1
    If UCase(Right(Filename, 3)) = "ASM" Then swFileTYpe = 2
    If UCase(Right(Filename, 3)) = "DRW" Then swFileTYpe = 3
    Set swDoc = Nothing
    If Dir(PathName & Filename) <> "" Then
        Set swDoc = swApp.OpenDoc(PathName & Filename, swFileTYpe) '开启文档
    End If
    If Not swDoc Is Nothing Then
        ColumnNumber = 4
        PropName = Cells(HeaderRow, ColumnNumber)
        While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到读完表头
            PropValue = swDoc.CustomInfo2("默认", PropName) '获取属性
            Sheet1.Cells(RowNumber, ColumnNumber) = PropValue
            ColumnNumber = ColumnNumber + 1 '下一栏
            PropName = Cells(HeaderRow, ColumnNumber)
        Wend '回到>直到读完表头
        swApp.CloseDoc PathName & Filename
        Cells(RowNumber, 1).Interior.Color = RGB(200, 255, 200)
        ReadFilesCount = ReadFilesCount + 1
    End If
    RowNumber = RowNumber + 1 '下一列
    PathName = Cells(RowNumber, 1)
Wend '回到>直到读完路径栏
MsgBox "读取了 " & ReadFilesCount & " 个文档的属性!"
End Sub

Sub WritePrp()  '写入文档属性
Set swApp = CreateObject("SldWorks.Application") '启动SW
SavedFilesCount = 0
HeaderRow = 2
RowNumber = 2
RowNumber = HeaderRow + 1
PathName = Cells(RowNumber, 1) '读取第一个路径的值
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到读完路径栏
    Filename = Cells(RowNumber, 2)
    If UCase(Right(Filename, 3)) = "PRT" Then swFileTYpe = 1
    If UCase(Right(Filename, 3)) = "ASM" Then swFileTYpe = 2
    If UCase(Right(Filename, 3)) = "DRW" Then swFileTYpe = 3
    Set swDoc = Nothing
    If Dir(PathName & Filename) <> "" Then
        Set swDoc = swApp.OpenDoc(PathName & Filename, swFileTYpe) '开启文档
    End If
    If Not swDoc Is Nothing Then
        ColumnNumber = 4
        PropName = Cells(HeaderRow, ColumnNumber)
        While Not (PropName = "" Or PropName = 0 Or IsEmpty(PropName)) '直到读完表头
            PropValue = Cells(RowNumber, ColumnNumber)
            swDoc.DeleteCustomInfo2 "默认", PropName '删除属性
            swDoc.AddCustomInfo3 "默认", PropName, 30, PropValue '新增属性
            ColumnNumber = ColumnNumber + 1 '下一栏
            PropName = Cells(HeaderRow, ColumnNumber)
        Wend '回到>直到读完表头
        Dim lErrors             As Long
        Dim lWarnings           As Long
        SaveOk = swDoc.Save3(1, lErrors, lWarnings)
        swApp.CloseDoc PathName & Filename '关闭
        If SaveOk Then
            Cells(RowNumber, 1).Interior.Color = RGB(255, 255, 127)
            SavedFilesCount = SavedFilesCount + 1
        End If
    End If
    RowNumber = RowNumber + 1 '下一列
    PathName = Cells(RowNumber, 1)
Wend '回到>直到读完路径栏
MsgBox "更新了 " & SavedFilesCount & " 个文档的属性!"
End Sub

發表於 2019/11/22 15:16:50 | 顯示全部樓層
用SwAPI這速度還行吧

我用SWDM-API讀取1000多個零件的屬性大概1分鐘左右

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x

點評

追问:读的都是零件.prt和装配文件.asm类型的吧,能分享下功能代码么?  詳情 回復 發表於 2019/11/22 16:41
你好,读跟写都是1分钟左右?  詳情 回復 發表於 2019/11/22 16:38
 樓主| 發表於 2019/11/22 16:38:08 | 顯示全部樓層
jbkndron 發表於 2019/11/22 15:16
用SwAPI這速度還行吧

我用SWDM-API讀取1000多個零件的屬性大概1分鐘左右

你好,读跟写都是1分钟左右?
 樓主| 發表於 2019/11/22 16:41:00 | 顯示全部樓層
jbkndron 發表於 2019/11/22 15:16
用SwAPI這速度還行吧

我用SWDM-API讀取1000多個零件的屬性大概1分鐘左右

追问:读的都是零件.prt和装配文件.asm类型的吧,能分享下功能代码么?

點評

我是用Visual Studio 2017寫的 程式碼連結:SolidWorks 文件管理工具.z ...  詳情 回復 發表於 2019/11/26 11:41
發表於 2019/11/26 11:41:37 | 顯示全部樓層
寫入自己德SWDM-API金鑰就可以用囉

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x

點評

C#开发的?  詳情 回復 發表於 2019/12/25 10:17
 樓主| 發表於 2019/12/25 10:17:33 | 顯示全部樓層
jbkndron 發表於 2019/11/26 11:41
寫入自己德SWDM-API金鑰就可以用囉

C#开发的?

點評

VB.NET  詳情 回復 發表於 2019/12/25 15:41
發表於 2019/12/25 15:41:27 | 顯示全部樓層

VB.NET

點評

工程图中套用的零件表非本公司专用范本,如何解决?  詳情 回復 發表於 2020/6/30 13:31
發表於 2020/6/30 13:31:22 | 顯示全部樓層

工程图中套用的零件表非本公司专用范本,如何解决?

本帖子中包含更多資源

您需要 登錄 才可以下載或查看,沒有賬號?註冊

x

點評

這要自己修改程式碼了,加油吧.... 我的公司轉用Creo了,所以我點沒在維護小工具了  詳情 回復 發表於 2020/7/2 16:40
發表於 2020/7/2 16:40:18 | 顯示全部樓層
quanshouzhu 發表於 2020/6/30 13:31
工程图中套用的零件表非本公司专用范本,如何解决?

這要自己修改程式碼了,加油吧....
我的公司轉用Creo了,所以我點沒在維護小工具了

點評

兄弟能否指点一下改哪些地方  詳情 回復 發表於 2020/7/2 16:53
發表於 2020/7/2 16:53:14 | 顯示全部樓層
jbkndron发表于2020/7/2 16:40
这要自己修改程式码了,加油吧....
我的公司转用Creo了,所以我点没在维护小工具了
...

兄弟能否指点一下改哪些地方file:///C:\Users\ADMINI~1\AppData\Local\Temp\SGPicFaceTpBq\17176\00D3E136.jpg
您需要登錄後才可以回帖 登錄 | 註冊

本版積分規則

論壇統計|手機版上論壇|論壇來自幾何科技 論壇架構版次 20240312

GMT+8, 2024/3/28 22:45 , Processed in 0.266365 second(s), 17 queries .

Powered by Discuz! X3.4 Licensed

© 2001-2023 Discuz! Team.

快速回復 返回頂部 返回列表