iCAx开思网

标题: 能否通过swdm实现获取零件外形尺寸 [打印本页]

作者: 口风琴 时间: 2016-5-15 21:28
标题: 能否通过swdm实现获取零件外形尺寸
本帖最后由口风琴于 2016-5-15 21:30 编辑

各位社友晚上好，上次论坛有位高人分享了一个非常好用的工具——excel VBA 批量更改solidworks 属性及名字工具
其中读取属性分普通版和高速版两种模式，其中高速版使用的是swdm-api进行操作文件

后来又在论坛搜索到闷大的帖子——在檔案管理而言, SWDM-API 與 SW-API 的分別，闷大在帖中展现的两种处理速度差异非常明显

这个对比非常强有力的展示了SWDM-API的优势，现excel VBA 批量更改solidworks 属性及名字工具中有个工具是读取零件外形尺寸，

我想把原作者的SW-API的方式修改为SWDM-API的方式，不知这种想法是否可以实现，望大家不吝赐教，谢谢各位

以下是模仿读取属性高速版代码修改的打开文件的代码（licenskey在此用xxxx做隐藏），但是到蓝色位置的时，得到Part和SelMgr均为空值

因本人是API小白，仅有一份强烈的好奇心，所以对下面代码的合理性与准确性没什么概念，请大家予以指正

Dim swDM As SwDMApplication
Dim swDoc As SwDMDocument12
Dim mOpenErrors As SwDmDocumentOpenError
Dim swCfgMgr As SwDMConfigurationMgr
Dim objClassfac As SwDMClassFactory
Dim vCustPropNameArr As Variant
Const SWDMLicenseKey = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx<span style="line-height: 1.5;">"</span>

复制代码

作者: 口风琴 时间: 2016-5-15 21:32
接上-------------------------------------
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

作者: wjxbxy 时间: 2018-4-2 12:52
找了好久，这个管用吗？试试！谢谢了！

欢迎光临 iCAx开思网 (https://www.icax.org/)