Hallo zusammen,
Wir haben ein Makro im Einsatz, das uns die Stückliste einer Zeichnung als TXT ablegt und dann in eine
Excel-Vorlage einfügt.
Klappt hervorragend.
Ich möchte aber jetzt das gleiche mit einer Stückliste machen, die in einer Baugruppe (Modell) eingefügt ist.
Da meine Programmierkenntnisse mehr als bescheiden sind, wäre ich für eure Hilfe sehr dankbar :-)
Hier der Code für die Zeichnungsstückliste:
Option Explicit
Public IVPoutput As String
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swSheet As SldWorks.Sheet
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swTable As SldWorks.TableAnnotation
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSheet = swModel.GetCurrentSheet --hier bleibt das Makro hängen---
IVPoutput = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) + ".txt"
If swModel Is Nothing Then
MsgBox "Keine Dokumentnte geöffnet."
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "Das Dokument ist keine Zeichnung."
End
End If
Set swDraw = swModel
' Get the first view
Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
' Get the first table annotation for this view
Set swTable = swView.GetFirstTableAnnotation
Do While Not swTable Is Nothing
ProcessTable swApp, swModel, swTable
' Get next table annotation for this view
Set swTable = swTable.GetNext
Loop
' Get the next view
Set swView = swView.GetNextView
Loop
' TXT-Datei löschen
Kill IVPoutput
End Sub
______________________________________________________________________
Sub ProcessTable _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swTable As SldWorks.TableAnnotation _
)
Dim swAnn As SldWorks.Annotation
Dim nNumCol As Long
Dim nNumRow As Long
Dim sRowStr As String
Dim i As Long
Dim j As Long
Dim intOutHandle As Integer
Dim sPath As String
Dim sCreate_Stückliste_SW_K As String
Dim ExcelApp As Excel.Application
Dim excelsheet As Excel.Worksheet
Dim excelbook As Excel.Workbook
Dim File As Object
Dim PosText As String
Set swAnn = swTable.GetAnnotation
intOutHandle = FreeFile
Open IVPoutput For Output As #intOutHandle
nNumCol = swTable.ColumnCount
nNumRow = swTable.RowCount
' Get the table contents
For i = 0 To nNumRow - 1
sRowStr = ""
For j = 0 To nNumCol - 1
sRowStr = sRowStr & swTable.Text(i, j) & Chr(9)
Next j
Print #intOutHandle, Left(sRowStr, Len(sRowStr) - 1)
Next i
Close #intOutHandle
PosText = UCase(swTable.Text(0, 0))
sPath = "L:\CAD-Systeme\SolidWorks\Dokumentationsvorlagen\Stueckliste\Vorlage_Stückliste.xlsm"
' Stücklistenerkennung durch Text in der 1. Spalte der SWX-Stückliste
If PosText = "PO." Then
sCreate_Stückliste_SW_K = "Vorlage_Stückliste.xlsm!Konstruktion.Create_Stückliste_SW"
End If
If PosText = "TEIL" Then
sCreate_Stückliste_SW_K = "Vorlage_Stückliste.xlsm!Konstruktion.Create_Stückliste_SW_Conti_Bab"
End If
If PosText = "POS" Then
sCreate_Stückliste_SW_K = "Vorlage_Stückliste.xlsm!Konstruktion.Create_Stückliste_SW_Conti_FFM"
End If
If PosText = "POS.-NR." Then
sCreate_Stückliste_SW_K = "Vorlage_Stückliste.xlsm!Konstruktion.Create_Stückliste_SW_Conti_Vil"
End If
Set ExcelApp = CreateObject("Excel.Application") 'Excel öffnen
ExcelApp.Visible = False 'Excel ausblenden
Set excelbook = ExcelApp.Workbooks.Open(sPath)
ExcelApp.Application.Run sCreate_Stückliste_SW_K, IVPoutput
excelbook.Close SaveChanges:=False
ExcelApp.Visible = True 'Excel einblenden
Set excelbook = Nothing
End Sub
_____________________________________________________________
Mein Problem ist die Stückliste in der BG zu erfassen, die auswertung müsste die gleiche sein.
Das Makro sollte für die Zeichnung und das Modell funktionieren.
Kann mir hier jemand weiterhelfen ?
Danke
------------------
Viele Wege führen zum Ziel .......... und ich will alle wissen !
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP