能否通过swdm实现获取零件外形尺寸

hpkzy · 发表于 2016-5-15 21:28:24

各位社友晚上好，上次论坛有位高人分享了一个非常好用的工具——excel VBA 批量更改solidworks 属性及名字工具
其中读取属性分普通版和高速版两种模式，其中高速版使用的是swdm-api进行操作文件
后来又在论坛搜索到大王的帖子——在檔案管理而言, SWDM-API 與 SW-API 的分別，大王在帖中展现的两种处理速度差异非常明显
这个对比非常强有力的展示了SWDM-API的优势，现excel VBA 批量更改solidworks 属性及名字工具中有个工具是读取零件外形尺寸，
我想把原作者的SW-API的方式修改为SWDM-API的方式，不知这种想法是否可以实现，望大家不吝赐教，谢谢各位
以下是模仿读取属性高速版代码修改的打开文件的代码（licenskey在此用xxxx做隐藏），但是到蓝色位置的时，得到Part和SelMgr均为空值
因本人是API小白，仅有一份强烈的好奇心，所以对下面代码的合理性与准确性没什么概念，请大家予以指正

复制代码

wohewaipo · 发表于 2016-5-17 07:29:17

接上-------------------------------------
Sub red_XYZ()
On Error Resume Next
Dim SelMgr As Object
Dim Part As Object
Dim FileName As String
Dim ColumnNumber As Integer
Dim PropName As String
Dim cx As Integer
Dim xy As Integer
Dim cz As Integer
Dim cw As Integer
Dim Mx As Integer
Dim nErrors As Long
Dim nWarnings As Long
Dim ix As Double
Dim boolstatus As Long
Dim longstatus As Long
HeaderRow = 2
RowNumber = 3
ColumnNumber = 6
PropName = Cells(HeaderRow, ColumnNumber)
'------------------------------------------------↓检查表头中是否有x、y、z
m_x = Cells(2, 2).End(xlToRight).Column
cx = 0
cy = 0
cz = 0
      While Len(PropName) > 0 '直到读完表头
      If cx > 0 And cy > 0 And cz > 0 Then ColumnNumber = m_x
         If PropName = "外形_L" Then
         cx = ColumnNumber
         End If
         If PropName = "外形_W" Then
         cy = ColumnNumber
         End If
         If PropName = "外形_H" Then
         cz = ColumnNumber
         End If
         If PropName = "规格" Then
         cw = ColumnNumber
         End If
         ColumnNumber = ColumnNumber + 1 '下一栏
         PropName = Cells(HeaderRow, ColumnNumber)
      Wend '回到>直到读完表头
If cx = 0 Then
Cells(2, 2).End(xlToRight).Offset(0, 1) = "外形_L"
cx = Cells(2, 2).End(xlToRight).Column
End If
If cy = 0 Then
Cells(2, 2).End(xlToRight).Offset(0, 1) = "外形_W"
cy = Cells(2, 2).End(xlToRight).Column
End If
If cz = 0 Then
Cells(2, 2).End(xlToRight).Offset(0, 1) = "外形_H"
cz = Cells(2, 2).End(xlToRight).Column
End If
'------------------------------------------------↑检查表头中是否有x、y、z
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '启动SWDM
'Set swApp = CreateObject("SldWorks.Application") '启动SW
RowNumber = HeaderRow + 1
PathName = Cells(RowNumber, 2)  '读取第一个路径的值
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到读完路径栏
FileName = Cells(RowNumber, 3) & "." & Cells(RowNumber, 4)
If UCase(Right(FileName, 3)) = "PRT" Then
Set swDoc = swDM.GetDocument(PathName & FileName, 1, False, mOpenErrors)
'Set Part = swApp.ActiveDoc
' Set swModel = swApp.OpenDoc6(PathName + FileName, 1, 0, "", nErrors, nWarnings)
Set Part = swDoc
Set SelMgr = Part.SelectionManager
'
If Cells(1, 5) = "1" Then
boolstatus = Part.Extension.SelectByID2("平板型式1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
longstatus = Part.SetBendState(2)
boolstatus = Part.EditRebuild3()
End If
'//////////////
Corners = Part.GetPartBox(True)
Y = Round(Abs(Corners(4) - Corners(1)) * 1000, 1) 'Y
Z = Round(Abs(Corners(5) - Corners(2)) * 1000, 1) 'Z
X = Round(Abs(Corners(3) - Corners(0)) * 1000, 1) 'X
If X < Y Then ix = X: X = Y: Y = ix
If Y < Z Then ix = Y: Y = Z: Z = ix
If X < Y Then ix = X: X = Y: Y = ix
Cells(RowNumber, cx) = X
Cells(RowNumber, cy) = Y
Cells(RowNumber, cz) = Z
If Cells(RowNumber, cw) <> X & "×" & Y & "×" & Z Then Cells(RowNumber, cw) = X & "×" & Y & "×" & Z
swApp.CloseDoc PathName & FileName '关闭工程图
Cells(RowNumber, 2).Select
Cells(RowNumber, 2).Interior.Color = RGB(255, 255, 127)
End If
RowNumber = RowNumber + 1 '下一列
PathName = Cells(RowNumber, 2)
Wend
MsgBox "零件外形尺寸读取完成"
End Sub

		自动登录	找回密码
密码			立即注册