AnsweredAssumed Answered

xPCB     What is wrong witch my script - VariantReport (csv)

Question asked by cornelia.goller on Jun 13, 2017
Latest reply on Jun 14, 2017 by peter_festesen

Hallo zusammen,

ich benötige einen delimiter ";" zwischen den Spalten - finde aber den Fehler nicht.

Für Hilfe wäre ich sehr dankbar.

Conny

 

 

Option Explicit

use "libdxd\util\VariantManagerUtils"

Dim projectPath, projectName, projectFile, libPath, sddHome, outputDir

'----------------------------------

Sub createVariantReport()

    On Error Resume Next

    Call stdOut("Creating VariantReport CSV ...", "MasterVariant")

    '-----------------------------------------------------
    ' Definitions
    Dim prjData : Set prjData = Application.GetProjectData()
    projectPath = prjData.GetProjectPath()
    projectName = prjData.GetProjectName()
    projectFile = prjData.GetProjectFilePath()

    libPath = Scripting.GetEnvVariable("HCC_LIB")
    sddHome = Scripting.GetEnvVariable("SDD_HOME")

    outputDir = projectPath & "\Datensammlung"

    '-----------------------------------------------------
    ' Check Definitions
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FolderExists(outputDir) Then
        fso.CreateFolder(outputDir)
    End If

    If Not fso.FolderExists(sddHome) Then Call Err.Raise(404, sddHome, "SDD_HOME not found")
    If Not fso.FolderExists(projectPath) Then Call Err.Raise(404, projectPath, "projectPath does not exist")
    If Not fso.FolderExists(outputDir) Then Call Err.Raise(404, outputDir, "outputDir Not Found")
    If Not fso.FileExists(projectFile) Then Call Err.Raise(404, projectFile, "couldn't find .prj file")

    If Err.Number <> 0 Then
        call stdOut("Error # " & CStr(Err.Number) & " " & Err.Description, "MasterVariant")
        Exit Sub
    End If

    Err.Clear

    '-----------------------------------------------------
    ' Open variant manager

    showVmGui True

    '-----------------------------------------------------
    ' get variant objects

    Dim vmDoc    : Set vmDoc    = getVmDocument()
    Dim vmAppObj : Set vmAppObj = getVmApplicationObject()

    '--------- collect data ----------

        Dim vmModifications : Set vmModifications = GetModifications(vmDoc)

    '--------- process variants ----------

    Dim cmp, line, pKey, ref, num

    '----------- create headers ---------------'

     Dim headers : Set headers = CreateObject ("Scripting.Dictionary")
     Dim i : i = 0
     headers.add "PARTNUMBER", i
     i = i+1
     headers.add "REFDES",  i
     i = i+1

    Dim vmVariant
    For Each vmVariant in vmDoc.Variants
      Dim vKey : vKey = vmVariant.Name
      headers.add vKey,  i
      i = i+1
    Next

     Dim data : Set data = CreateObject ("Scripting.Dictionary")
     Dim ix : ix = 0

    For Each cmp In vmDoc.Components

        Dim fields : Set fields = CreateObject ("Scripting.Dictionary")

        Set pKey = nothing
        Set ref  = nothing
        Set num  = nothing

        pKey  = cmp.Name
        ref  = cmp.Name
        num  = cmp.PartNumber

        fields.add headers("REFDES"), ref
        fields.add headers("PARTNUMBER"), num

        For Each vmVariant in vmDoc.Variants

            vKey = vmVariant.Name

            Dim modifiedParts

            If vmModifications.exists(vKey) Then
                Set modifiedParts = vmModifications(vKey)

                If modifiedParts.exists(pKey) Then
                    Dim part : Set part = modifiedParts(pKey)

                    If part.isFitted Then
                        fields.add headers(vKey), part.PartNumber
                    Else
                        fields.add headers(vKey), "<unplaced>"
                    End If

                End If
            End If

        Next

        data.add ix, fields

        ix = ix + 1

    Next

        Dim file, filename, csvContent

        'filename = outputDir & "\" & projectName & ".csv"
  filename = outputDir & "\" & "var_report_" & projectName & ".csv"
        csvContent     = RenderCvs(headers,data)
        Set file = fso.CreateTextFile(filename)
        file.Write(csvContent)
        file.Close

        Call stdOut("Output: " & filename, "MasterVariant")

 

    '-----------------------------------------------------
    ' exit

    vmAppObj.ResetView
        Application.ActiveView.Refresh
    showVmGui False

    '-----------------------------------------------------
    ' error handling
    If Err.Number <> 0 Then
        call stdOut("Error # " & CStr(Err.Number) & " " & Err.Description, "MasterVariant")
        Err.Clear
    End If

End Sub

    '============================================

Class PartsItem
    Public Id
    Public PartNumber
    Public RefDes
    Public Description
    Public IsFitted
End Class

'============================================
' Returns Multi-Dim Dictionary
' modifications[VariantName][RefDesKey]'

Function GetModifications(vmDoc)

    Dim dict : Set dict = CreateObject ("Scripting.Dictionary")

    Dim vmCmpMods : Set vmCmpMods = vmDoc.ComponentModifications

    Dim vmCmpMod, part, sid, ref, num, isFitted, list, vKey, pKey

    For Each vmCmpMod in vmCmpMods

        Set vKey = nothing
        Set list = nothing
        Set part = nothing
        Set pKey = nothing
        Set ref  = nothing
        Set num  = nothing
        Set sid  = nothing

        isFitted = true

        vKey = vmCmpMod.variant.Name

        If Not dict.exists(vKey) Then
            Set list = CreateObject ("Scripting.Dictionary")
            dict.add vKey, list
        End If

        Set list = dict(vKey)

        pKey = vmCmpMod.Component.Name
        ref  = vmCmpMod.Component.Name
        num  = vmCmpMod.Component.PartNumber
        sid  = vmCmpMod.Component.SID

        'replaced Part
        If vmCmpMod.Operation = 2 Then
            num   = vmCmpMod.NewPartNumber
        End If

        'unplaced Part
        If vmCmpMod.Operation = 1 Then
            isFitted = false
        End If

        'if mech cell add uniqueId
        If sid <> "" Then
            pKey = pKey &"."& sid
        End If

        Set part = New PartsItem
        part.RefDes      = ref
        part.PartNumber  = num
        part.IsFitted    = isFitted

        list.add pKey, part
    Next

    Set GetModifications = dict 'Return
End Function

Function RenderCvs(headers, data)

    Dim format

    Dim hCount : hCount = headers.Count -1

    Dim headerIx
    For Each headerIx In headers.Keys
            format = format & """{"& headers(headerIx)&"}" '";"
    Next

    format = format & vbCrLF

    Dim content

    content = format

    'write header'
    For Each headerIx In headers.Keys
        content = Replace(content,"{" & headers(headerIx) & "}", headerIx)
    Next

    Dim dataIx, line
    For Each dataIx in data

        line   = format

        Dim fields : set fields = data(dataIx)

        Dim i
        For i=0 To hCount
            If fields.exists(i) Then
                line = Replace(line,"{"& i &"}",fields(i))
            Else
                line = Replace(line,"{"& i &"}","")
            End If
        Next

        content = content & line
    Next

    RenderCvs = content 'RETURN

End Function

Outcomes