XML Datei auslesen / Material Datenbank in Solidworks

Mit diesem Code kann man in VBA die Solidworks Material Datenbank durchgehen.

Damit der Code funktioniert, muss vorher noch der Verweis auf die Microsoft XML aktiviert werden. Davon gibt es zwei. Einmal die v3 und dann, wie im Bild zu sehen, die v6.

Mit der Sub GetMaterialDatabasesNames kann man sich alle Material Datenbankennamen und -pfade anzeigen lassen, welche auf dem System vorhanden sind.

Mit der Sub DokumentReferenzieren durchläuft man alle Knoten in der XML Datei. Im Beispiel habe ich die SolidWorks Material Datenbank genommen.

Option Explicit
Sub GetMaterialDatabasesNames()
    Dim swApp As SldWorks.SldWorks
    Dim vMaterialDatabases As Variant
    Dim vMaterialDatabase As Variant
    Set swApp = Application.SldWorks
    vMaterialDatabases = swApp.GetMaterialDatabases
    Debug.Print "Material schema path name = " & swApp.GetMaterialSchemaPathName
    For Each vMaterialDatabase In vMaterialDatabases
        Debug.Print "  " & vMaterialDatabase
    Next
End Sub
Public Sub DokumentReferenzieren()
    Dim xmlDoc As DOMDocument60
    Set xmlDoc = New DOMDocument60
    If xmlDoc.Load("c:\program files\solidworks corp\solidworks\lang\german\sldmaterials\solidworks materials.sldmat") = True Then
        Dim oXmlNodeList As IXMLDOMNodeList
        Set oXmlNodeList = xmlDoc.childNodes
        IterateNodes oXmlNodeList.Item(0)
    Else
        Debug.Print "Fehler beim Einlesen:"
        Debug.Print "ErrorCode: " & xmlDoc.parseError.ErrorCode
        Debug.Print "Filepos:   " & xmlDoc.parseError.filepos
        Debug.Print "Line:      " & xmlDoc.parseError.Line
        Debug.Print "LinePos:   " & xmlDoc.parseError.linepos
        Debug.Print "Reason:    " & xmlDoc.parseError.reason
        Debug.Print "srcText:   " & xmlDoc.parseError.srcText
        Debug.Print "Url:       " & xmlDoc.parseError.url
    End If
End Sub
Private Sub IterateNodes(parent As IXMLDOMNode)
    If Not parent Is Nothing Then
        Dim xmlAttributes As IXMLDOMNamedNodeMap
        Set xmlAttributes = parent.Attributes
        If parent.hasChildNodes Then
            IterateNodes parent.firstChild
        End If
        IterateNodes parent.nextSibling
    End If
End Sub

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert