VBA - Benutzerinteraktion und Stückliste

PDM
1

Hallo ihr alle 

Lassen Sie mich Ihnen meine Situation erklären. Ich arbeite an Baugruppen mit mehreren hundert Teilen und muss einige Teilepläne im PDF-Format exportieren. Dazu füge ich eine Stücklistentabelle in meine Baugruppe ein. Die letzte Spalte der Tabelle sagt mir, ob wir den Plan des Raumes wollen oder nicht. Dann exportiere ich die Pläne, die mich interessieren, nacheinander im PDF-Format.

Ich würde gerne ein Programm erstellen, das all dies ein wenig automatisiert, um mir Zeit zu sparen. Ich möchte, dass der Benutzer die Teilenummer in ein Dialogfeld eingibt (z.B. "25", um den 25. Teil der Tabelle auszuwählen). Dann öffnet das Programm den Plan, der mit dem ausgewählten Raum verknüpft ist, und speichert ihn als PDF. 

Der zweite Teil des Programms ist für mich kein Problem, aber die Auswahl des Teils anhand seiner Nomenklaturnummer ist für mich ein Problem. Ich kann kein Programm erstellen, das in der Lage ist, den 25. Teil der Nomenklaturtabelle zu lesen und zu finden und den Plan dieses Teils zu öffnen. Wenn du irgendwelche Ideen hast, würde es mir sehr helfen.

In der Hoffnung, klar genug zu sein:)

Danke für Ihre Hilfe

2

Hallo;

Hier ist ein Beispiel für das Zählen der Zeilen:
http://help.solidworks.com/2020/English/api/sldworksapi/Get_Components_in_Each_BOM_Table_Row_VB.htm?verRedirect=1

Die Variable, an der Sie interessiert sein sollten, lautet: nNumRow = swTableAnn. Zeilenanzahl

Ein weiteres Makro zum direkten Öffnen eines Plans aus einer Nomenklatur:

https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/post:YxLaeuf8RRWPjMc6PF9ulA

' ###################################################
' # Title: Open Drawing From BOM                    #
' # Version: 21.9.6                                 #
' # Author: Stefan Sterk                            #
' # Company: Idee Techniek Engineering B.V.         #
' #                                                 #
' # This macro will try to open the drawing for the #
' # selected component(s) in the Bill of Meterials. #
' #                                                 #
' # NOTE: Drawing file must be in same folder as    #
' # component and must have the same filename       #
' ###################################################
 
Option Explicit
 
Dim swApp As SldWorks.SldWorks
 
Sub main()
 
    Dim swModel  As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swTblAnn As SldWorks.TableAnnotation
    Dim swBOMTbl As SldWorks.BomTableAnnotation
    Dim swComp   As SldWorks.Component2
 
    Dim i As Integer, selType  As Integer
    Dim frtRow As Long, lstRow As Long
    Dim frtCol As Long, lstCol As Long
    Dim Row As Integer
 
    Dim vComps   As Variant
    Dim CfgName  As String
 
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
 
    If swModel Is Nothing Then Exit Sub
    If Not swModel.GetType = swDocDRAWING Then Exit Sub
 
    Set swSelMgr = swModel.SelectionManager
 
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
 
        selType = swSelMgr.GetSelectedObjectType3(i, -1)
 
        If selType <> 98 Then
            MsgBox "Please select a cel from BOM!"
            Exit Sub
        End If
 
        Set swTblAnn = swSelMgr.GetSelectedObject6(i, -1)
        Set swBOMTbl = swTblAnn
 
        swTblAnn.GetCellRange frtRow, lstRow, frtCol, lstCol
 
        For Row = frtRow To lstRow
            CfgName = swBOMTbl.BomFeature.GetConfigurations(True, True)(0)
            vComps = swBOMTbl.GetComponents2(Row, CfgName)
            If Not IsEmpty(vComps) Then
                Set swComp = swBOMTbl.GetComponents2(Row, CfgName)(0)
                openComponentDrawing swComp
            End If
        Next Row
 
    Next i
End Sub
 
Private Function openComponentDrawing(swComp As Component2)
 
    Dim compPath As String
    compPath = swComp.GetPathName
 
    Dim drwPath As String
    drwPath = Left(compPath, InStrRev(compPath, ".") - 1) & ".slddrw"
 
    ' Try Open Drawing
    Dim swDrw As SldWorks.DrawingDoc
    Dim errors As Long, warnings As Long
    Set swDrw = swApp.OpenDoc6(drwPath, swDocDRAWING, 0, "", errors, warnings)
 
    If errors <> 0 Then
        If errors = 2 Then
            Dim partNumber As String
            partNumber = Right(drwPath, Len(drwPath) - InStrRev(drwPath, "\"))
            partNumber = Left(partNumber, InStrRev(partNumber, ".") - 1)
            MsgBox "Couldn't find drawing for following part number: " & partNumber
        End If
    Else
        swApp.ActivateDoc3 drwPath, False, 0, errors
    End If
 
End Function

Herzliche Grüße.

2 „Gefällt mir“