10 Replies Latest reply on Jun 14, 2017 2:06 AM by peter_festesen

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

    cornelia.goller

      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