Zugriff auf Spaltengleichung einer Stückliste per Makro (DS SolidWorks/SolidWorks) - Lösung vorhanden!

Hallo SWX

-Gemeinde,

auf meinen Beitrag habe ich leider keine Antwort erhalten. Wahrscheinlich liegt es daran, dass es nicht möglich ist per VBA auf diese Gleichungen zuzugreifen. Habe mich durch die Hilfe und andere Foren gewühlt und nichts gefunden auch mit der Funktion, mit der man die Eigenschaften auswählen kann hat man keine Chance.
Habe es nun anders gelöst. Meine Gleichung multipliziert die Stückzahl mit dem Inhalt einer anderen Spalte, und in jede Zeile dieser Spalte schreibe ich den Multiplikator rein, und blende die Spalte aus.

Nachfolgend der Code zum Einfügen der Stückliste.
Vor dieser Routine hat der Benutzer angegeben ob Englisch und
die Anzahl. Die Anzahl wird an die Routine übergeben. Ist sie
kleiner 0 dann wird Englisch verwendet.
Die Stückliste wird an der Position der ausgewählten Ansicht eingefügt.
Vielleicht kann jemand den ein oder anderen Teil verwenden.

Sub StueliEinfuegen(ByVal nAnzahl As Long)

Dim swApp As SldWorks.SldWorks 'Zugriff auf SolidWorks
Dim PartDoc As SldWorks.ModelDoc2 'Zugriff auf Aktuelles Dokument
Dim DrwDoc As SldWorks.DrawingDoc 'Zugriff auf Aktuelle Zeichnung
Dim AktModelView As SldWorks.View 'Zugriff auf Aktive Ansicht
Dim ModAusView As SldWorks.ModelDoc2 'Zugriff auf das Modell der Zeichnung

Dim vPos As Variant 'Position der Ansicht
Dim Stueli As SldWorks.BomTableAnnotation 'Zugriff auf Stückliste
Dim StTable As SldWorks.BomFeature 'Zugriff auf Tabellenfeature
Dim swTable As SldWorks.TableAnnotation 'Zugriff auf Spalten und Texte
Dim vStAnno As Variant 'Zugriff auf Inhalte
Dim sConfig As String 'Konfiguration des Modells in der Ansicht
Dim sUeberschr As String 'Inhalt der Überschrift
Dim nI As Long 'Zähler
Dim dHeight As Long 'Zeilenhöhe
Dim sVorlage As String 'Tabellenvorlage
Dim sAnzahl As String 'Text für Fertigungsanzahl
Dim nMerk As Long 'Merker

'SolidWorks-Objekt erstellen und mit Aktivem Dokument verbinden
Set swApp = Application.SldWorks
Set PartDoc = swApp.ActiveDoc

If (PartDoc.GetType <> swDocDRAWING) Then
' wenn keine Zeichnung aktiv wird das Makro wieder beendet
Call MsgBox("Aktuelles Dokument ist keine Zeichnung!", vbCritical + vbOKOnly, "Fehler !")
Exit Sub
End If
Set DrwDoc = PartDoc
Set AktModelView = DrwDoc.ActiveDrawingView
If AktModelView Is Nothing Then
' wenn keine Ansicht aktiv wird das Makro wieder beendet
Call MsgBox("Keine Ansicht aktiviert!", vbCritical + vbOKOnly, "Fehler !")
Exit Sub
End If
Set ModAusView = AktModelView.ReferencedDocument

'Entsprechend dem Wert von nAnzahl die Tabellenvorlage auswählen
If nAnzahl < 0 Then
If nAnzahl < -1 And (ModAusView.GetType = swDocASSEMBLY) Then
sVorlage = "L:\SWX_APPS_2013\Vorlagen\Stücklistenvorlagen\WKS-Fertigung-Mehrfach-Englisch.sldbomtbt"
Else
sVorlage = "L:\SWX_APPS_2013\Vorlagen\Stücklistenvorlagen\WKS-Fertigung-Englisch.sldbomtbt"
End If
nAnzahl = nAnzahl * -1
sUeberschr = "bill of materials for: "
sAnzahl = " - manufacture " + CStr(nAnzahl) + " piece"
If nAnzahl > 1 Then
sAnzahl = sAnzahl + "s"
End If
Else
If nAnzahl > 1 And (ModAusView.GetType = swDocASSEMBLY) Then
sVorlage = "L:\SWX_APPS_2013\Vorlagen\Stücklistenvorlagen\WKS-Fertigung-Mehrfach.sldbomtbt"
Else
sVorlage = "L:\SWX_APPS_2013\Vorlagen\Stücklistenvorlagen\WKS-Fertigung.sldbomtbt"
End If
sUeberschr = "Stückliste zu: "
sAnzahl = " - " + CStr(nAnzahl) + " Stück fertigen"
End If

'Tabelle mit Bezug zur aktuell dargestellten Konfiguration einfügen
sConfig = AktModelView.ReferencedConfiguration
vPos = AktModelView.Position
Set Stueli = AktModelView.InsertBomTable4(False, vPos(0), vPos(1), swBOMConfigurationAnchor_BottomLeft, swBomType_PartsOnly, _
sConfig, sVorlage, False, swIndentedBOMNotSet, True)
Set StTable = Stueli.BomFeature
ni = StTable.GetTableAnnotationCount
If ni = 1 Then
vStAnno = StTable.GetTableAnnotations
Set swTable = vStAnno(0)
Else
' wenn mehrere Tabellen im Feature dann kann keine Tabelle eingefügt werden
Call MsgBox("Aufgrund mehrerer Tabellen in der Ansicht kann keine Überschrift eingefügt werden!", vbCritical + vbOKOnly, "Fehler !")
Exit Sub
End If
If (ModAusView.GetType = swDocASSEMBLY) Then
'Ist Baugruppe, nun noch Überschrift einblenden und benennen
sUeberschr = sUeberschr & CStr(ModAusView.CustomInfo2(sConfig, "Desc1"))
If CStr(ModAusView.CustomInfo2(sConfig, "Desc2")) <> "" Then
sUeberschr = sUeberschr & " " & CStr(ModAusView.CustomInfo2(sConfig, "Desc2"))
End If
sUeberschr = sUeberschr + sAnzahl
If InStr(1, CStr(ModAusView.CustomInfo2(sConfig, "PWDB_field9")), "lackiert", vbTextCompare) > 0 Then
If Left(sUeberschr, 1) = "b" Then
sUeberschr = sUeberschr + " - paint coated"
Else
sUeberschr = sUeberschr + " - lackiert"
End If
End If
If InStr(1, CStr(ModAusView.CustomInfo2(sConfig, "PWDB_field9")), "verzinkt", vbTextCompare) > 0 Then
If Left(sUeberschr, 1) = "b" Then
sUeberschr = sUeberschr + " - zinc coated"
Else
sUeberschr = sUeberschr + " - verzinkt"
End If
End If

swTable.TitleVisible = True
swTable.Title = sUeberschr

'Nun noch die Gesamtanzahl eventuell eintragen
If nAnzahl > 1 Then
nMerk = swTable.RowCount
For ni = 2 To nMerk - 1
swTable.Text(ni, 2) = CStr(nAnzahl)
Next ni
swTable.ColumnHidden(2) = True
End If
Else
'Ist Teil, Überschrift ausblenden, und falls lackiert oder verzinkt wird diese wieder einblenden
swTable.TitleVisible = False
If nAnzahl > 1 Then
'Anzahl > 1 somit Stückzahl anpassen
swTable.Text(1, 1) = CStr(nAnzahl)
End If
sUeberschr = sUeberschr & CStr(ModAusView.CustomInfo2(sConfig, "Desc1"))
If Left(CStr(ModAusView.CustomInfo2(sConfig, "Desc2")), 5) <> Auftragsnummer(CStr(ModAusView.CustomInfo2(sConfig, "Field1"))) Then
sUeberschr = sUeberschr & " " & CStr(ModAusView.CustomInfo2(sConfig, "Desc2"))
End If
sUeberschr = sUeberschr & sAnzahl
If InStr(1, CStr(ModAusView.CustomInfo2(sConfig, "PWDB_field9")), "lackiert", vbTextCompare) > 0 Then
If Left(sUeberschr, 1) = "b" Then
sUeberschr = sUeberschr + " - paint coated"
Else
sUeberschr = sUeberschr + " - lackiert"
End If
swTable.TitleVisible = True
swTable.Title = sUeberschr
End If
If InStr(1, CStr(ModAusView.CustomInfo2(sConfig, "PWDB_field9")), "verzinkt", vbTextCompare) > 0 Then
If Left(sUeberschr, 1) = "b" Then
sUeberschr = sUeberschr + " - zinc coated"
Else
sUeberschr = sUeberschr + " - verzinkt"
End If
swTable.TitleVisible = True
swTable.Title = sUeberschr
End If
End If

End Sub

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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