3 Replies Latest reply on Mar 14, 2017 4:57 AM by Jiří Konečný

    Export dat komponent sestavy do listboxu (pole)

    Jiří Konečný

      Zdravím,

       

      Existuje možnost získání informací z komponent sestavy (vlastnosti závislé na konfiguraci) a následný zápis například do listboxu nebo do pole?

       

      Potřebuji exportovat data kusovníku nejvyšší úrovně přímo ze sestavy, ale tvorby bez kusovníku.

       

      Děkuji

        • Re: Export dat komponent sestavy do listboxu (pole)
          Deepak Gupta

          You can insert a BOM in the assembly and can export it to Excel OR use assembly visualization tool and export that table

           

          Můžete vložit kusovník v sestavě a lze exportovat do Excelu nebo pomocí montážní vizualizační nástroj a exportovat tuto tabulku

          • Re: Export dat komponent sestavy do listboxu (pole)
            Ivana Kolin

            asi bych zacla tady s tim ze ten Feature Level neni potreba:

            2016 SOLIDWORKS API Help - Traverse Assembly at Component and Feature Levels Using Recursion Example (VBA)

            A component ma property 2016 SOLIDWORKS API Help - ExcludeFromBOM Property (IComponent2)

             

            PS: lidi co rozumi cesky tady asi moc neni, takze muzete cekat dost dlouho na odpoved.

            • Re: Export dat komponent sestavy do listboxu (pole)
              Jiří Konečný

              Tak jsem nakonec došel k tomuto (Pole, které obsahuje data kusovníku nejvyšší úrovně):

               

              Sub Polozky()

              Dim swApp                       As SldWorks.SldWorks
              Dim swModel                     As SldWorks.ModelDoc2
              Dim FileName As String
              Dim SeznamKomponent As New Collection
              Dim SeznamKomponentTest As String
              Dim Val As String, Val2 As String, Val3 As String, Val4 As String
              Dim CisloVykresuKompSestavy As String, NazevKompSestavy As String, NazevKompSestavy_ENG As String, HmotnostKompSestavy As String

               


              Set swApp = CreateObject("SldWorks.Application")
              Set swModel = swApp.ActiveDoc

              Debug.Print "File = " & swModel.GetPathName

              'kolekce komponent sestavy dle čísla konfigurace a definice pouziti v kusovniku
              VatComp1 = swApp.ActiveDoc.GetComponents(True)
              For i = 0 To UBound(VatComp1)
                  Set swComp1 = VatComp1(i)
                  FileName = Left(swComp1.Name, InStrRev(swComp1.Name, "-", -1, vbTextCompare) - 1) & " <" & swComp1.ReferencedConfiguration & ">"
                  If InStr(1, SeznamKomponentTest, FileName) = 0 And swComp1.ExcludeFromBOM = False Then
                      SeznamKomponent.Add (FileName)
                      Debug.Print ("Položka kolekce: " & FileName)
                      SeznamKomponentTest = SeznamKomponentTest & FileName
                  End If
              Next

              'pole kusovníku sestavy
              Dim swModExt As SldWorks.ModelDocExtension
              Dim swAssembly As SldWorks.AssemblyDoc
              Dim MassProp As SldWorks.MassProperty
              Set swAssembly = swModel
              Set swModExt = swModel.Extension
              Set MassProp = swModExt.CreateMassProperty

              ReDim Kusovnik(SeznamKomponent.Count - 1, 6)
              VatComp = swApp.ActiveDoc.GetComponents(True)
              For i = 0 To UBound(VatComp)
                  Set swComp = VatComp(i)
                  Set Swcompdoc = swComp.GetModelDoc2
                  Set swAssembly = swModel
                  Set swModExt = swModel.Extension
                  Set MassProp = swModExt.CreateMassProperty
                    
                  On Error Resume Next
                  Set swCfgPropMgr = Swcompdoc.Extension.CustomPropertyManager(swComp.ReferencedConfiguration)
                  If Err.Number = 91 Then 'ignorování potlačených komponent
                      GoTo PotlacenyDil
                  Else
                      If Err.Number <> 0 Then
                          Msg = "Error # " & Str(Err.Number) & " was generated by " _
                          & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
                          MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
                          FORM_Export_Access.Hide
                          Exit Sub
                      End If
                  End If
                 
                  FileName = Left(swComp.Name, InStrRev(swComp.Name, "-", -1, vbTextCompare) - 1) & " <" & swComp.ReferencedConfiguration & ">"
                 
                  Dim Shoda As Boolean
                  Shoda = False
                  For k = 1 To SeznamKomponent.Count 'porovnání s kolekcí komponent
                      test = SeznamKomponent.Item(k)
                      If SeznamKomponent.Item(k) = FileName Then
                          Shoda = True
                          Exit For
                      End If
                  Next
                 
                  If Shoda = True Then 'tvorba kusovníku
                      For a = 0 To UBound(Kusovnik)
                          If Kusovnik(a, 0) <> "" Then
                              If Kusovnik(a, 0) = FileName Then
                                  Kusovnik(a, 3) = Kusovnik(a, 3) + 1
                                  Exit For
                              End If
                          Else
                              t = swCfgPropMgr.Get4("Cislo vykresu", False, Val, CisloVykresuKompSestavy)
                              t = swCfgPropMgr.Get4("Nazev", False, Val2, NazevKompSestavy)
                              t = swCfgPropMgr.Get4("Nazev_ENG", False, Val3, NazevKompSestavy_ENG)
                              t = swCfgPropMgr.Get4("Hmotnost_Kg", False, Val4, HmotnostKompSestavy)
                              Dim HmotnostKompSestavyS As Single
                              HmotnostKompSestavy = Replace(HmotnostKompSestavy, ".", ",")
                              HmotnostKompSestavyS = CSng(HmotnostKompSestavy) * 1
                              Kusovnik(a, 0) = FileName
                              Kusovnik(a, 1) = CisloVykresuKompSestavy
                              Kusovnik(a, 2) = NazevKompSestavy
                              Kusovnik(a, 3) = 1
                              Kusovnik(a, 4) = "Ks"
                              Kusovnik(a, 5) = NazevKompSestavy_ENG
                              Kusovnik(a, 6) = HmotnostKompSestavyS
                              Exit For
                          End If
                      Next
                  End If
              PotlacenyDil:
              Next

              QuickSort Kusovnik, LBound(Kusovnik), UBound(Kusovnik)

              LBKusovnik.Clear
              For a = 0 To UBound(Kusovnik)
                  With LBKusovnik
                      .AddItem
                      .List(a, 0) = Kusovnik(a, 1)
                      .List(a, 1) = Kusovnik(a, 2)
                      .List(a, 2) = Kusovnik(a, 3)
                      .List(a, 3) = Kusovnik(a, 4)
                      .List(a, 4) = Kusovnik(a, 5)
                      .List(a, 5) = Kusovnik(a, 6)
                  End With
                  Debug.Print Kusovnik(a, 1) & "   " & Kusovnik(a, 2) & "   " & Kusovnik(a, 3) & " " & Kusovnik(a, 4) & " " & Kusovnik(a, 5) & " " & Kusovnik(a, 6)
              Next
              End Sub

               

              Sub QuickSort(Pole As Variant, DolniMez As Long, HorniMez As Long)
                 Dim Pivot As Variant
                 Dim k As Variant
                 Dim i As Long
                 Dim j As Long
                 i = DolniMez
                 j = HorniMez
                 Pivot = Pole((DolniMez + HorniMez) \ 2, 1)
                 While (i <= j)
                    While (Pole(i, 1) < Pivot And i < HorniMez)
                       i = i + 1
                    Wend
                    While (Pivot < Pole(j, 1) And j > DolniMez)
                       j = j - 1
                    Wend
                    If (i <= j) Then
                      k0 = Pole(i, 0)
                      k1 = Pole(i, 1)
                      k2 = Pole(i, 2)
                      k3 = Pole(i, 3)
                      k4 = Pole(i, 4)
                      k5 = Pole(i, 5)
                      k6 = Pole(i, 6)
                      Pole(i, 0) = Pole(j, 0)
                      Pole(i, 1) = Pole(j, 1)
                      Pole(i, 2) = Pole(j, 2)
                      Pole(i, 3) = Pole(j, 3)
                      Pole(i, 4) = Pole(j, 4)
                      Pole(i, 5) = Pole(j, 5)
                      Pole(i, 6) = Pole(j, 6)
                      Pole(j, 0) = k0
                      Pole(j, 1) = k1
                      Pole(j, 2) = k2
                      Pole(j, 3) = k3
                      Pole(j, 4) = k4
                      Pole(j, 5) = k5
                      Pole(j, 6) = k6
                      i = i + 1
                      j = j - 1
                    End If
                 Wend
                 If (DolniMez < j) Then QuickSort Pole, DolniMez, j
                 If (i < HorniMez) Then QuickSort Pole, i, HorniMez
              End Sub

               

               

              Dá se nějak označené oblasti (zjištění hmotnosti komponent z vlastnosti závislé na konfiguraci) nahradit něčím podobným, s tím že to prozradí hmotnost komponenty a né celé sestavy? podobně jako takto u celkové hmotnosti:

               

              Dim Extn As SldWorks.ModelDocExtension
              Dim vMassProp As Variant
              Dim nStatus As Long

              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set Extn = swModel.Extension


              vMassProp = Extn.GetMassProperties2(1, nStatus, False)


              If Round(vMassProp(5), 6) > 0 Then                                                   'zaokrouhlení
                  M = 0
                  i = 3
                  Do Until M <> 0
                      M = Round(vMassProp(5), i)
                      i = i + 1
                  Loop
              End If
              Hmotnost.Value = M