在Excel读Solidworks的尺寸数据

ning84

excel与Solidworks 通讯程序
Function SetSwPart()
  Dim SwApp As Object
  Dim SelMgr As Object, boolStatus As Boolean
  Dim longstatus As Long, longwarnings As Long
  'Debug.Print IsNull(swApp)
  'Set SwApp = CreateObject("sldworks.application")
  Set SwApp = GetObject(, "sldworks.application")
  'Debug.Print IsNull(swApp)
  Set SetSwPart = SwApp.ActiveDoc
  'Debug.Print SetSwPart.GetPathName
End Function
''****************************

Private Sub ReadSwDimensionInSldPrt()
  ''读SW的变量数据
  Dim oDic
  Set oDic = CreateObject("Scripting.Dictionary")
   
  
  nn = Range("A65536").End(3).Row
  Set Rng = Range("A1:Z" & nn)
  'Rng.ClearContents
    Dim swFeat As Object, swSubFeat As Object
    Dim swDispDim As Object, SwDim As Object
    Dim swAnn As Object
    Dim bRet As Boolean
   
    Set SwApp = CreateObject("SldWorks.Application")
    Set SwPart = SetSwPart
    Set swFeat = SwPart.FirstFeature
   
    'Debug.Print "File = " & SwPart.GetPathName
    kk = 1
    Do While Not swFeat Is Nothing
        Debug.Print "  " + swFeat.Name
        Set swSubFeat = swFeat.GetFirstSubFeature
        Do While Not swSubFeat Is Nothing
            Debug.Print "      " + swSubFeat.Name
            
            Set swDispDim = swSubFeat.GetFirstDisplayDimension
            Do While Not swDispDim Is Nothing
                Set swAnn = swDispDim.GetAnnotation
                Set SwDim = swDispDim.GetDimension
                Debug.Print "          [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
                'Debug.Print swDim.FullName, swDim.GetSystemValue2("")
                Set swDispDim = swSubFeat.GetNextDisplayDimension(swDispDim)
            Loop
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop
        
        Set swDispDim = swFeat.GetFirstDisplayDimension
        Do While Not swDispDim Is Nothing
            Set swAnn = swDispDim.GetAnnotation
            Set SwDim = swDispDim.GetDimension
            
            Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
            Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
            Str = SwDim.FullName
            oArr = Split(Str, "@")
            Str = oArr(0) & "@" & oArr(1)
            '
            Cells(kk, 5) = SwDim.GetSystemValue2("")
            Cells(kk, 4) = oArr(1)
            Debug.Print SwDim.GetSystemValue2("")
            oDic(Str) = SwDim.GetSystemValue2("")
            
            Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
            kk = kk + 1
        Loop
        Set swFeat = swFeat.GetNextFeature
    Loop
    Dim oArr1, oArr2, cc
    cc = 6
    oArr1 = oDic.keys: oArr2 = oDic.items
    For kk = 1 To UBound(oArr1) + 1
        Cells(kk, 1 + cc) = kk - 1
        Cells(kk, 2 + cc) = "=" & """Arr(""" & " & " & Cells(kk, 1 + cc).Address(0, 0) & " & " & """)="""
        Cells(kk, 3 + cc) = "'" & Chr(34) & oArr1(kk - 1) & Chr(34)
        Cells(kk, 4 + cc) = Split(oArr1(kk - 1), "@")(1)
        Cells(kk, 5 + cc) = oArr2(kk - 1)
   
    Next kk
End Sub
'--------------------------------------
'
' Preconditions:
'      (1) Part or assembly document is open.
'      (2) Display dimension is selected.
'
' Postconditions: None
'
'--------------------------------------
Private Sub ReadDimensionNameInSldDrw()
  ''读Drawing的尺寸，传送到Temp表。
  nn = Range("A65536").End(3).Row
  Set Rng = Range("A1:Z" & nn)
  Rng.ClearContents
    Dim swModel               As Object
    Dim SwDrawing             As Object
    Dim SwView                As Object
    Dim swDispDim             As Object
    Dim SwDim                 As Object
    Dim bRet                    As Boolean
    Dim Str
    ' Get SolidWorks application
    'Set swApp = Application.SldWorks
    ' Get active document
    Set swModel = SetSwPart
    ' Downcast model to a drawing
    Set SwDrawing = swModel
    ' The first view is the drawing sheet
    Set swSheetView = SwDrawing.GetFirstView
    ' Print its contents
    'PrintView swSheetView
    ' Get the sketch for the drawing sheet view
    'Set SwSketch = swSheetView.GetSketch
    ' Print its contents
    'PrintSketch swSketch
    ' Traverse all "real" views on the sheet
    ' First view on the sheet.
    Set SwView = swSheetView.GetNextView
    ''
    kk = 3
    Do While Not SwView Is Nothing
        'PrintView swView
        'Debug.Print swView.Name
        Set swDispDim = SwView.GetFirstDisplayDimension()
        While Not swDispDim Is Nothing
          Set SwDim = swDispDim.GetDimension
          oArr = Split(SwDim.FullName, "@")
          Str = oArr(0) & "@" & oArr(1)
          ss = Str 'Left(Str, InStr(Str, ".") - 1)
          Cells(kk, 1) = kk - 3
          Cells(kk, 2) = "=" & """     Arr(""" & " & " & Cells(kk, 1).Address(0, 0) & " & " & """)="""
          Cells(kk, 3) = Chr(34) & Str & Chr(34)
          Cells(kk, 4) = Chr(34) & SwDim.FullName & "@" & SwView.Name & Chr(34)
          'Cells(kk, 4) = "'" & swDim.FullName & "@" & swView.Name
          kk = kk + 1
          Set swDispDim = swDispDim.GetNext2
        Wend
       Set SwView = SwView.GetNextView
    Loop
End Sub

chenyin0824

如何使用？？、、

ss404770848

针对零件很好用，  但 部件下所有零件的尺寸读不出来，楼主能指导下不？

plzhangying

感谢分享！！！

ss404770848

伟大的楼主，还在不在，指导下：一个部件中怎么将所有零部件特征的尺寸遍历写入excel？

864163213

不知道怎么用