9 Replies Latest reply on Jul 1, 2018 9:34 AM by Fifi Riri

    Extract characteristic materials

    Paul Kerouanton

      Hello everybody,

      I try to extract the materials characteristic  with the API into excel for all part of my assembly.

      materiaux.JPG

      For the moment my program can display the name of the material for one part (Part Doc). But I can't display the name of the material for an assembly (assembly Doc). progamme matériaux.JPG

      If you have any ideas do not hesitate to contact me

        • Re: Extract characteristic materials
          Fifi Riri

          What do you mean by "material for an assembly"?

          To my knowledge an assembly doesn't have a material, only parts have one.

           

          At best you could get total weight and volume.

          And from there calculate the density.

          • Re: Extract characteristic materials
            Fifi Riri

            Hello

            Run this macro with an assembly opened

            It will create a Excel file ".CSV" in C:\MyFolder\

            MatExcel.jpg

             

            For this macro to work: Add reference to Microsoft XML, v 6.0 (although other version will work)

             

             

            Dim swApp As SldWorks.SldWorks

            Dim swAssy As SldWorks.AssemblyDoc

            Dim longstatus As Long, longwarnings As Long

             

            Sub main()

                Set swApp = Application.SldWorks

                Dim swConf As SldWorks.Configuration

                Dim swRootComp As SldWorks.Component2

                Set swAssy = swApp.ActiveDoc

                Set swConf = swAssy.GetActiveConfiguration

                Set swRootComp = swConf.GetRootComponent3(True)

                WriteCSVFile "Part Name" & "," & "Property" & "," & "Property value"

                TraverseComponent swRootComp

            End Sub

             

            Sub TraverseComponent(swComp As SldWorks.Component2)

                Dim vChilds As Variant, vChild As Variant

                Dim swChildComp As SldWorks.Component2

                vChilds = swComp.GetChildren

                For Each vChild In vChilds

                    Set swChildComp = vChild

                    Dim FileName As String

                    FileName = swChildComp.GetPathName

             

                    If UCase(Right(FileName, Len(FileName) - InStr(FileName, "."))) = "SLDPRT" Then

                        Dim swPart As SldWorks.ModelDoc2

                        Set swPart = swApp.OpenDoc6(swChildComp.GetPathName, 1, 0, "", longstatus, longwarnings)

                     

                        Dim dbs      As Variant

                        Dim sMatName As String

                        Dim sMatDB   As String

                        'Get all of the material databases defined in the Material

                        'database folders of this session of SolidWorks

                        dbs = swApp.GetMaterialDatabases

             

                        'Get the material name of the currently selected part for the Default configuration

                        sMatName = swPart.GetMaterialPropertyName2("Default", sMatDB)

             

                        WriteCSVFile Left(swPart.GetTitle, InStr(swPart.GetTitle, ".") - 1)

                        WriteCSVFile ",Material," & sMatName

             

                        'Check the list of available databases from above, for a match to this part's material

                        For Each db In dbs

                            If UCase(Left(Right(db, Len(sMatDB) + 7), Len(sMatDB))) = UCase(sMatDB) Then

                                'Call function to get custom property from .sldmat xml using:

                                '   the database determined above

                                '   the material of the part determined above

                                cProp = GetMatProperties(sMatName, CStr(db))

                                Exit For

                            End If

                        Next

                        swApp.CloseDoc swPart.GetTitle

                    End If

                    TraverseComponent swChildComp

                Next

            End Sub

             

            Function GetMatProperties(materialName As String, materialDatabaseFile As String) As Variant

            Dim xml_doc As New DOMDocument

            Dim onode   As IXMLDOMElement

            Dim pnode   As IXMLDOMNode

            Dim cnode   As IXMLDOMNode

             

            'xml_doc exiting reference

            If xml_doc.Load(materialDatabaseFile) Then

                'Get any nodes that are labeled as materials

                For Each onode In xml_doc.selectNodes("//material")

                    'Look for the material we are interested in

                    If onode.getAttribute("name") = materialName Then

                        'Look for the physical properties node in child nodes of the material

                        For Each cnode In onode.childNodes

                            If cnode.baseName = "physicalproperties" Then

                                For Each pnode In cnode.childNodes

                                    'Debug.Print pnode.Attributes.Item(0).nodeValue & " = " & pnode.Attributes.Item(1).nodeValue

                                    WriteCSVFile "," & pnode.Attributes.Item(0).nodeValue & "," & pnode.Attributes.Item(1).nodeValue

                                Next

                            End If

                        Next

                        WriteCSVFile ""

                        Exit For

                    End If

                   Next

            Else

                MsgBox "Unable to open XML File"

            End If

            End Function

             

            Sub WriteCSVFile(logSTR As String)

                Dim My_filenumber As Integer

                My_filenumber = FreeFile

                Open "C:\MyFolder\Sample.csv" For Append As #My_filenumber

                Print #My_filenumber, logSTR

                Close #My_filenumber

            End Sub