---

Hallo Forum,

ich habe vor einiger Zeit ein AddIn für Inventor 10 geschrieben, das beim Beenden einer IDW die Stückliste der Zeichnung nach Excel exportiert. Leider werden dabei die Baugruppen nicht aufgelöst.

Hier ein Auszug aus meinem Quellcode:

Private oPartList As PartsList
...
  For i = 1 To DocumentObject.Sheets.Count
    If DocumentObject.Sheets(i).PartsLists.Count > 0 Then
      Set oPartList = DocumentObject.Sheets(i).PartsLists.Item(1)
      ...
      Dim counterRow As Long
      For counterRow = 1 To oPartList.PartsListRows.Count
        Dim oRow As PartsListRow
        Set oRow = oPartList.PartsListRows.Item(counterRow)
   
        For counterColumn = 1 To oPartList.PartsListColumns.Count
          Dim oCell As PartsListCell
          Set oCell = oRow.Item(counterColumn)
          oExcelWks.Cells(counterRow + 1, counterColumn) = ""
                                                  + CStr(oCell.Value)
        Next
      Next
      ...

Hat jemand eine Idee wie ich die ganze Stückliste bekomme? Ich habe die Vermutung das es an dieser Zeile liegt:
Set oPartList = DocumentObject.Sheets(i).PartsLists.Item(1)

Gruß
Dietmar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dietmar,

ich glaube du mußt die Stücklistenzeile, die eine Baugruppe darstellt, erst expandieren. Dazu gibt es in PartsListRow die Eigenschaften Expandable und Expanded.
Jede Reihe mit expandable abfragen, ob expandieren möglich ist, und dann mit expanded=true expandieren.

gruß
Reinhard

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dietmar
Hier eine Lösung:

' DrawingDocument an Fungtion übergeben
' ungefähr so:
' Call fuc_ADI_Start_Drw(ThisApplication.ActiveDocument)

Function fuc_ADI_Start_Drw(ByRef cDrw As Inventor.DrawingDocument)
 
  On Error Resume Next
 
  Dim idApp      As Inventor.Application
  Dim idTraGeo  As Inventor.TransientGeometry
  Dim idDrwViw  As Inventor.DrawingView
 
  Dim idAcSh    As Inventor.Sheet
  Dim idSket    As Inventor.DrawingSketch
  Dim idTeBo    As Inventor.TextBox
 
  Dim idDimS As Inventor.DrawingDimensions
  Dim idDim0 As Inventor.DrawingDimension
 
  Dim idParLis As Inventor.PartsList
  Dim idPoint2 As Inventor.Point2D
 
  Dim idParLisRow As Inventor.PartsListRow
 
  Set idApp = cDrw.Parent                            ' Applijkation bestimmen
  Set idTraGeo = idApp.TransientGeometry            ' Geometriebereich bestimmen
  Set idAcSh = cDrw.ActiveSheet                      ' Zeichnung bestimmen
 
  Set idDrwViw = idAcSh.DrawingViews.Item(1)        ' Ansicht der abgeleiteten Assembly bestimmen
  Set idPoint2 = idTraGeo.CreatePoint2d(80, 60)      ' Position links unten besimmen
 
 
  ' Stückliste auf Blatt positionieren
  ' 3. Position kann  kPartsOnly oder kFirstLevelComponents
  ' kFirstLevelComponents sinnvoll wenn Assembly gesichtet werden soll
  Call idAcSh.PartsLists.Add(idDrwViw, idPoint2, kFirstLevelComponents, 1, 1, True)
  ' Stückliste ist auf Blatt positionieren
 
  ' Zeile aus der Ztückliste bestimmen
  Set idParLisRow = idAcSh.PartsLists.Item(1).PartsListRows.Item(1)
 
  idParLisRow.Expanded = True  ' Zeile aufklappen wenn Assembly
 
  ' und jetzt speichern als excel file
  ' 1. Position = Pfad
  ' 2. Position = speichern als
  ' 1. Position = Tabellen Name
  Call idAcSh.PartsLists.Item(1).Export("c:\temp\PartsLists.xls", kMicrosoftExcel, "Ingolf")
 
End Function

------------------
das Leben ist schön, meint Ingolf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP