---

Hallo miteinander,

ich komme mal wieder bei der Erstellung eines Makros nicht weiter. Vielleicht kann mir von Euch jemand helfen.

Ich möchte mit dem Makro Bedingungen in einer Baugruppe erstellen. Dazu soll in dem einen Bauteil ein Punkt in einer Skizze selektiert werden und in einem anderen Bauteil soll anschließend eine Fläche selektiert werden. Mit folgendem Code versuche ich es um zusetzten.

Code:

---

Sub main()

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim rsClick As Integer
Dim Anzahl As Variant
Dim count As Long
Dim swFeatRS As SldWorks.Feature
Dim swSelDataRS As SldWorks.SelectData
Dim Benennung_RefGeo1 As String

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager

rsClick = MsgBox(prompt:="Bitte die Referenzgeometrie der Bedingung" & vbLf & "selektiern." , Buttons:=vbYesNo, Title:="Auswahl Referenzgeometrie")
             
            If rsClick = vbYes Then
                 
                    Part.ClearSelection2 True
                    Anzahl = 1
                    Select Case Anzahl
                        Case 1
                            MsgBox "Bitte die Refernzgeometrieselektieren", vbInformation
                        Case Else
                            MsgBox "Bitte die Refernzgeometrieselektieren", vbInformation
                   
                    End Select
                       
                       
                    Set swFeatRS = SelMgr.GetSelectedObject6(1, -1)
                    Set swSelDataRS = SelMgr.CreateSelectData
                   
                    Benennung_RefGeo1 = swFeatRS.Name
                    MsgBox Benennung_RefGeo1
       
            Else
           
                Exit Sub
       
            End If

---

Features, sowie Ebenen und Achsen kann ich damit auswählen, aber leider nicht die benötigten Elemente. Weiß jemand wie ich den Code ändern muss damit es funktioniert?

Viele Grüße
Torsten

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

---

Hallo Torsten,

was meinst du mit Bedingungen? Meinst du eine Verknüpfung?

Dein Macro macht irendwie nichts sinnvolles, die forderst dazu auf das jemanand etwas selektiert, das geht aber nicht weil die MsgBox da ist. Wenn vorher etwas selektiert ist, löscht du die Selektierung bevor du wieder dazu aufforderst das der Anwender doch bitte etwas selektieren soll.

Du hast eine Select Case Anweisung deren sinn sich mir auch nicht erschließt, weil in jedem Case das gleiche passiert.

Sollte doch was selektiert sein, was ja theoretisch nicht der Fall ist (außer man selektiert was im Einzelschritt Modus), wird ein Feature Name abgefragt, woher der auch immer kommen sollte, weil wo wurde den bitte ein Feature selektiert.

Falls du Verknüpfungen erstellen willst schau dir mal das Beispiel "Create Standard Mates Example (VBA)" aus der API-Hilfe an.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für deine Antwort. Ja ich meine Verknüpfungen. Sorry sind noch die alten Angewohnheiten Aus CATIA Zeiten...

Ich werde mir morgen Früh gleich mal das Beispiel "Create Standard Mates Example (VBA)" aus der API-Hilfe anschauen.

Durch den Select Case ist es mir möglich, nachdem die MsgBox angezeigt wurde, im Featurebaum oder im 3D etwas zu selektieren. Ohne das Select Case und MsgBox ist das Makro, auswelchem ich den Code kopiert habe, immer weitergelaufen und ich konnte nichts selektieren. Daher war meine Hoffnung das ich es auch in der Baugruppe anwenden kann.

Viele Grüße
Torsten

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

---

Hallo Torsten,

Zitat:

---

Durch den Select Case ist es mir möglich, nachdem die MsgBox angezeigt wurde, im Featurebaum oder im 3D etwas zu selektieren

---

Eine MsgBox ist immer gebunden daher kannst du nichts anderes anklicken solange diese aktiv ist, was du benötigst wäre z.B. eine ungebundene UserForm (Eigenschaft ShowModal = False), weil wenn eine ungebundene UserForm offen ist kannst du nebenbei auch etwas selektieren.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für deine Antwort. Wie funktioniert das mit der ungebundenen UserForm? So richtig habe ich dazu nichts in der API Hilfe gefunden.

Der Arbeitsstand des Makros sieht derzeit wie folgt aus:

Code:

---

Sub main()

Dim swApp As Object
Dim swAssembly As AssemblyDoc
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Dim swAssembly As AssemblyDoc

' Neue Baugruppe erstellen
Set Part = swApp.NewDocument("C:\SolidWorks\Data\templates\Baugruppe.asmdot", 0, swSheetWidth, swSheetHeight)
Set swAssembly = Part
swApp.ActivateDoc2 "Baugruppe1", False, longstatus
Set Part = swApp.ActiveDoc

' Referenzbauteil als Hülle in die Baugruppe einfügen (Envelop = Hülle)
Dim swNewEnvelope As Component2
Set swNewEnvelope = Part.InsertEnvelope("C:\SolidWorks\Projekt\Referenz_Baugruppe.SLDPRT", "", 1.57643877462214, 1.57940425564975, 1.57971713378014)
Dim TransformData() As Double
ReDim TransformData(0 To 15) As Double
TransformData(0) = 1
TransformData(1) = 0
TransformData(2) = 0
TransformData(3) = 0
TransformData(4) = 1
TransformData(5) = 0
TransformData(6) = 0
TransformData(7) = 0
TransformData(8) = 1
TransformData(9) = 0
TransformData(10) = 0
TransformData(11) = 0
TransformData(12) = 1
TransformData(13) = 0
TransformData(14) = 0
TransformData(15) = 0
Dim TransformDataVariant As Variant
TransformDataVariant = TransformData
Dim swMathUtil As Object
Set swMathUtil = swApp.GetMathUtility()
Dim swTransform As Object
Set swTransform = swMathUtil.CreateTransform((TransformDataVariant))
boolstatus = swNewEnvelope.SetTransformAndSolve2(swTransform)

' Zoom To Fit
Part.ViewZoomtofit2

' Baugruppe speichern
boolstatus = Part.Extension.SelectByID2("Referenz_Baugruppe-1@Baugruppe1", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.EditPart
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Gleichungen", "EQNFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Part.EditAssembly

' Insert Component
Dim AssemblyTitle As String
AssemblyTitle = Part.GetTitle
Dim tmpObj As ModelDoc2
Dim errors As Long
Set tmpObj = swApp.OpenDoc6("C:\SolidWorks\Vorlagedateien\Vorlage1.SLDPRT", 1, 32, "", errors, longwarnings)
Set Part = swApp.ActivateDoc3(AssemblyTitle, True, 0, errors)
Dim swInsertedComponent As Component2
Set swInsertedComponent = Part.AddComponent5("C:\SolidWorks\Vorlagedateien\Vorlage1.SLDPRT", 0, "", False, "", -0.608038299754696, -0.603924454331775, -0.6062577503223)
swApp.CloseDoc "C:\SolidWorks\Vorlagedateien\Vorlage1.SLDPRT"

Dim rsClick As Integer
Dim Anzahl As Variant
Dim count As Long
Dim swFeatRS As SldWorks.Feature
Dim swSelDataRS As SldWorks.SelectData
Dim Benennung_Skizzenebene As String

Set SelMgr = Part.SelectionManager

rsClick = MsgBox(prompt:="Bitte die Referenzgeometrie 1 der Verknüpfung" & vbLf & "selektiern.", Buttons:=vbYesNo, Title:="Auswahl Referenzebene Winkel")
             
            If rsClick = vbYes Then
                 
                    Part.ClearSelection2 True
                    Anzahl = 1
                    Select Case Anzahl
                        Case 1
                            MsgBox "Bitte die Refernzgeometrie 1 selektieren", vbInformation
                        Case Else
                            MsgBox "Bitte die Refernzgeometrie 1 selektieren", vbInformation
                    End Select
                       
                    count = SelMgr.GetSelectedObjectCount2(-1)
                    While count <= Anzahl - 1
                        DoEvents
                        count = SelMgr.GetSelectedObjectCount2(-1)
                    Wend
                                           
                       
                    Set swFeatRS = SelMgr.GetSelectedObject6(1, -1)
                    Set swSelDataRS = SelMgr.CreateSelectData
                   
            Else
           
                Exit Sub
       
            End If

Dim rsClick1 As Integer
Dim Anzahl1 As Variant
Dim count1 As Long
Dim swFeatRS1 As SldWorks.Feature
Dim swSelDataRS1 As SldWorks.SelectData
Dim Benennung_Skizzenebene1 As String

'Set SelMgr = Part.SelectionManager
rsClick1 = MsgBox(prompt:="Bitte die Referenzgeometrie 2 der Verknüpfung" & vbLf & "selektiern.", Buttons:=vbYesNo, Title:="Auswahl Referenzebene Winkel")

            If rsClick1 = vbYes Then
                 
                    Part.ClearSelection2 True
                    Anzahl1 = 1
                    Select Case Anzahl1
                        Case 1
                            MsgBox "Bitte die Refernzgeometrie 2 selektieren", vbInformation
                        Case Else
                            MsgBox "Bitte die Refernzgeometrie 2 selektieren", vbInformation
                    End Select
                       
                    count = SelMgr.GetSelectedObjectCount2(-1)
                    While count <= Anzahl1 - 1
                        DoEvents
                        count = SelMgr.GetSelectedObjectCount2(-1)
                    Wend
                       
                    Set swFeatRS1 = SelMgr.GetSelectedObject6(1, -1)
                    Set swSelDataRS1 = SelMgr.CreateSelectData
                   
                       
            Else
           
                Exit Sub
       
            End If

Dim CoincMateData As SldWorks.CoincidentMateFeatureData
Dim EntitiesToMate(1) As Object
Dim EntitiesToMateVar As Variant
Dim MateFeature As Feature

' Create CoincidentMateFeatureData
Set CoincMateData = swAssembly.CreateMateData(0)

' Set the Entities To Mate
Set EntitiesToMate(0) = swFeatRS                            'SelMgr.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = swFeatRS1                          'SelMgr.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
CoincMateData.EntitiesToMate = (EntitiesToMateVar)

' Set the Mate Alignment
CoincMateData.MateAlignment = 0

' Create the mate
Set MateFeature = swAssembly.CreateMate(CoincMateData)
Part.ClearSelection2 (True)
Part.EditRebuild3

boolstatus = Part.Extension.SelectByRay(-2.65813760897231E-02, 5.40093074191077E-02, -1.91102240282248E-02, -0.400036026779312, -0.515038074910024, -0.758094294050284, 2.99151229353486E-03, 2, True, 1, 0)
boolstatus = Part.Extension.SelectByRay(0.104493667114582, 5.40093074190509E-02, -0.053508121263917, -0.400036026779312, -0.515038074910024, -0.758094294050284, 2.99151229353486E-03, 2, True, 1, 0)

End Sub

---

Damit kann ich derzeit leider nur Achsen, Ebenen und Features selektieren und die gewünschte Verknüpfung erstellen. Weißt du wie ich über die Selektion an Flächen oder Punkte in Skizzen kommen kann?

Viele Grüße
Torsten

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

---

insUF_VBA.png

Hallo Torsten,

macht es überhaupt sinn deine Selektion Manuell tätigen zu wollen? Das bei dir die Feature selektiert sind liegt evtl. daran das du die Feature im Feature-Baum selektierst? Des Weiteren wird in deinem Code ja auch ein Feature erwartet "Dim swFeatRS As SldWorks.Feature".

Eine UserForm ist ein eigenes Object in VBA diese kannst du z.B. über das "Einfügen-Menü" einfügen. Die UserForm ist VBA Allgemein daher musst du auch in der VBA-Hilfe suchen und nicht in der SWX-API-Hilfe.

Was hast du den in diesem Abschnitt vor, es steht zwar Baugruppe speichern drüber aber du machst alles mögliche nur nicht speichern.

Code:

---

' Baugruppe speichern
boolstatus = Part.Extension.SelectByID2("Referenz_Baugruppe-1@Baugruppe1", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.EditPart
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Gleichungen", "EQNFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Part.EditAssembly

---

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielleicht sollte ich erklären was ich mit dem Makro machen möchte. Es soll damit eine neue Baugruppe erstellt werden, in welcher ein Referenzbauteil, ein Flansch und ein Stutzenrohr eingefügt werden. In dem Referenzbauteil ist die Position des Flansches im Raum definiert. Dies erfolgt mithilfe einer Ebene und einer Skizze welche die Einfügepunkte für die einzelnen Flansche enthält. Für diesen Einfügepunkt benötige ich den Zugriff auf die Skizzenpunkte. Im Flansch sollen zur Positionierung mehrere Flächen angewählt werden. Wenn alles mit Verknüpfungen positioniert wurde soll dann die Baugruppe gespeichert und geschlossen werden. Da die Punkte in der Skizze in Position und Anzahl variieren können muss ich sie über Selektion im 3D auswählen.

Das mit dem Speichern verstehe ich auch nicht wirklich.  Aber wenn ich mit Einzelschritten durch das Makro gehe, wird in diesem Bereich das Fenster zum Speichern unter geöffnet...

Ah ok, mit UserForm habe ich noch nicht gearbeitet. Muss dazu sagen das ich mir das VBA selbst beigebracht habe und dadurch öfters mal an meine Grenzen stoße. Werde mich jetzt mit dem Thema aber mal genauer beschäftigen.

Vielen Dank auch für den Hinweis das hier "Dim swFeatRS As SldWorks.Feature" ein Feature erwartet wird. Gibt es in der API Hilfe eine Auflistung als was ich das alles deklarieren kann? Eine Suche nach "SldWorks" oder "Feature" brachte mich nicht wirklich weiter.

Vielen Dank noch einmal und viele Grüße
Torsten

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

---

Hallo Torsten,

Zitat:

---

Das mit dem Speichern verstehe ich auch nicht wirklich.  Aber wenn ich mit Einzelschritten durch das Makro gehe, wird in diesem Bereich das Fenster zum Speichern unter geöffnet...

---

Das liegt daran das du eine Komponentenbearbeitung startetst (Part.EditPart) und das lässt SWX nur zu wenn die Baugruppe vorher schon mal gespeichert war.

Zitat:

---

Gibt es in der API Hilfe eine Auflistung als was ich das alles deklarieren kann? Eine Suche nach "SldWorks" oder "Feature" brachte mich nicht wirklich weiter.

---

Nicht das ich wüßte, weil das sind ja doch einige hundert, du kannst Objecte in der Suche erkennen wenn der Name mit einem "I" anfängt und dahinter Interface und darunter "Member Methoden Overview (Properties)" steht.

Aber mal weg vom Macro, kannst du das einfügen Positionieren nicht mit Verknüpfungsreferenzen erledigen?

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Guten Morgen Bernd,

vielen Dank für Deine Antwort. Jetzt verstehe ich warum das Fenster zum Speichern sich öffnet. 

Mit den Verknüpfungsreferenzen arbeite ich zwischen Flansch und Stutzenrohr. Zwischen der Skizze und dem Flansch funktioniert es leider nicht, weil sich die Skizze mit jedem Auftrag komplett ändert. Daher wäre es super wenn dass mit der Selektion klappen würde.

Besteht die Möglichkeit die Verknüpfungsreferenzen per Makro miteinander zu verknüpfen? Bei der Makroaufzeichnung wird leider nichts dazu mit aufgezeichnet.

Viele Grüße
Torsten

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

---

Hallo Thor,

hat die Skizze in der die Punkte sind und die Ebenen evtl. immer die gleichen Namen, weil wenn du manuell selektierst könntest du eigentlich auch gleich die Verknüpfung machen. 

Zitat:

---

Besteht die Möglichkeit die Verknüpfungsreferenzen per Makro miteinander zu verknüpfen? Bei der Makroaufzeichnung wird leider nichts dazu mit aufgezeichnet.

---

Theoretisch is das möglich aber dann wird das ganze Projekt noch komplexer (AddSmartComponent Method (IAssemblyDoc))

BTW: Für ein erstes VBA Projekt mit SWX hast du dir da schon eine nicht ganz triviale Aufgabe ausgesucht.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Guten Morgen Bernd,

vielen Dank für deine Antwort. Im Prinzip ist der Name von der Skizze und der Ebene immer gleich. Allerdings gibt es meist einen inneren und einen äußeren Stutzenkreis. Ebenfalls kann es mehrere Ebenen für unterschiedliche Stutzengrößen geben. Daher dachte ich das es mit einer Selektion einfacher von statten geht. Ich hatte wirklich nicht damit gerechnet, dass es so schwierig ist diesen einen Punkt zu selektieren.

Bei der Verbindung des Flansches und des Stutzenrohres gibt es schon Verknüpfungsreferenzen. Diese haben immer die gleiche Bezeichnung. Da habe ich es hinbekommen die Verknüpfungen per Makro zu erstellen.

Mittlerweile bekomme ich auch den Punkt selektiert. Allerdings hapert es noch mit der Erstellung der Verknüpfung...

Sobald ich das Makro etwas bereinigt habe stelle ich es noch einmal hier ein.

Ich werde mich gleich mal in (AddSmartComponent Method (IAssemblyDoc)) einlesen.

Viele Grüße
Torsten

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

---

Test_BG_Stutzen.zip

Hallo Bernd,

ich habe heute weiter an dem Makro gearbeitet, und eine erste lauffähige Version erstellt.

Die Auswahl des Punktes habe ich erst einmal mit der mir bekannten Variante bewerkstelligt. Als nächstes werde ich versuchen das ganze über eine ungebundene UserForm umzusetzen.

Eine Frage habe ich zum Speichern von Bauteilen in einer Baugruppe. Wie kann ich diese unter einem neuen Namen abspeichern, dass sich auch die Benennung im Featurebaum mit ändert? Bei der Baugruppe habe ich es geschafft, aber beiden Bauteilen funktioniert es leider nicht.

Viele Grüße
Torsten

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

---

Zitat:

---

Original erstellt von Thor16:
Hallo Bernd,

ich habe heute weiter an dem Makro gearbeitet, und eine erste lauffähige Version erstellt. Diese befindet sich in der angefügten ZIP-Datei.

Die Auswahl des Punktes habe ich erst einmal mit der mir bekannten Variante bewerkstelligt. Als nächstes werde ich versuchen das ganze über eine ungebundene UserForm umzusetzen.

Eine Frage habe ich zum Speichern von Bauteilen in einer Baugruppe. Wie kann ich diese unter einem neuen Namen abspeichern, dass sich auch die Benennung im Featurebaum mit ändert? Bei der Baugruppe habe ich es geschafft, aber beiden Bauteilen funktioniert es leider nicht.

Viele Grüße
Torsten

---

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

---

Hallo Torsten,

Code:

---

Set Part = swApp.ActivateDoc3("Stutzenrohr_Stutzen_Referenz.SLDPRT", True, 0, Errors)
bRet = Part.SaveAs4("C:\SolidWorks\ProjektXY\Stutzen_Stutzen_N1_EN1092-1-Typ11B1.SLDPRT", 0, 2, Errors, Warnings) 'Option 2 nicht 1, evtl. kann es auch die 512 sein muss man mal testen
Set Part = swApp.ActivateDoc3("Stutzen_N1.SLDASM", True, 0, Errors)

---

Kannst du Versuchen die neusten Varianten zu einer Methode zu verwendet bzw. zumindest immer die gleiche z.B. verwendest du ActivateDoc3 (ISldWorks) und ActivateDoc2 (ISldWorks) die beide theoretisch das selbe machen. Des Weiteren kannst du auf die Variablen bRet / bret1 verzichten wenn du dafür die vorhandene Variable boolstatus verwendest, das Selbe ist auch für Warnings = longwarnings und Errors = longerrors der Fall (longerrors am besten auch dimensionieren).

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für Deine Antwort. Jetzt funktioniert das mit dem Speichern auch super. 

Ich habe auch, wie von dir vorgeschlagen, die Variablen ausgetauscht. War mir vorher nur nicht sicher ob ich da die gleichen verwenden kann.

Viele Grüße
Torsten

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

---

Hallo Torsten,

du könntest um das ganze etwas zu kürzen, das einstellen der Konfiguration direkt beim einfügen der Komponente machen, da du bei der Methode AddComponent5 auch die Möglichkeit hast die Konfiguration in der du die Komponente einfügen möchtest gleich mitgeben kannst.

Code:

---

' Einfügen der Komponente 1 in der gewünschten Konfiguration und speichern der Komponente unter neuem Namen
Set swPart = swApp.OpenDoc6("C:\SolidWorks\Vorlagedateien\Stutzen_Referenz_EN1092-1-Typ11B1.SLDPRT", 1, 32, "", longerrors, longwarnings)
'Set swModelDoc = swApp.ActivateDoc3(AssemblyTitle, True, 0, Errors)
Set swInsertedComponent = swModelDoc.AddComponent5("C:\SolidWorks\Vorlagedateien\Stutzen_Referenz_EN1092-1-Typ11B1.SLDPRT", 0, "", Ture, "DN 50 PN 016", -0.608038299754696, -0.603924454331775, -0.6062577503223)
boolstatus = swPart.SaveAs4("C:\SolidWorks\ProjektXY\Stutzen_Stutzen_N1_EN1092-1-Typ11B1.SLDPRT", 0, 2, longerrors, longwarnings)
swApp.CloseDoc "Stutzen_Referenz_EN1092-1-Typ11B1.SLDPRT"

---

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für den Hinweis. Ich habe es so ein geändert. Langsam nimmt das Makro ordentlich Gestalt an. 

Wo ich leider noch nicht wirklich weiter komme ist die UserForm. Ich habe mir jetzt eine erstellt um die ganzen Namen und Pfade, vor dem Start der Abarbeitung des Makros, eingeben zu können. Das funktioniert auch super. 

Allerdings weiß ich nicht wie ich mit einer UserForm den nachfolgenden Bereich des Makros ändern kann. 

Code:

---

' Selektion der Skizze um den Namen der Skizze zu bekommen.
    rsSClick = MsgBox(prompt:="Bitte die Skizze, welche die Position der Stutzen" & vbLf & "enthält, selektiern.", Buttons:=vbYesNo, Title:="Auswahl Skizze Referenzposition")
                 
                If rsSClick = vbYes Then
                     
                        Part.ClearSelection2 True
                        Anzahl = 1
                        Select Case Anzahl
                            Case 1
                               
                                MsgBox "Bitte die Skizze für den Referenz-" & vbLf & "punkt selektieren.", vbInformation
                            Case Else
                                MsgBox "Bitte die Skizze für den Referenz-" & vbLf & "punkt selektieren.", vbInformation
                        End Select
                           
                        count = SelMgr.GetSelectedObjectCount2(-1)
                        While count <= Anzahl - 1
                            DoEvents
                            count = SelMgr.GetSelectedObjectCount2(-1)
                        Wend
                           
                        Set swFeatRSS = SelMgr.GetSelectedObject6(1, -1)
                        Set swSelDataRSS = SelMgr.CreateSelectData
                       
                        NameSkizze = swFeatRSS.Name
                     
                Else
               
                    Exit Sub
           
                End If

---

Hast du dazu vielleicht auch noch eine Idee?

Viele Grüße
Torsten

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

---

Hallo Torsten,

an was hapert es den genau mit der zusätzlichen UserForm dem Aufrufen, der Gestaltung, dem Positionieren oder der Bindung (gebunden / ungebunden)?

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Guten Morgen Bernd,

im Prinzip weiß ich nicht wie ich mit einer UserForm dafür sorgen kann die Auswahl im 3D durchführen zu können. 

Wie kann ich während des Makrodurchlaufes die UserForm aufrufen und dabei die Elemente auswählen? Leider habe ich dazu noch nicht das Richtige gefunden.

Viele Grüße
Torsten

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

---

UFShowModeles_VBA_SWX.png

Hallo Torsten,

aufrufen kannst du die UserForm mit

Code:

---

Userformname.Show

---

Wie du es ja bei der ersten UserForm ja eigentlich auch machst?
In der UserForm musst du dann nur die Eigenschaft "ShowModal" auf False setzen, dann solltest du etwas selektieren können, hier musst du dann nur noch eine "Warteschleife" einbauen damit das Macro nicht einfach weiter läuft, weil es eine ungeundene UserForm ist.

Im Main Modul

Code:

---

UserForm1.Show

While UserForm1.Visible
    DoEvents
Wend

'Folgecode

---

In der Userform bei OK schließen

Code:

---

Private Sub cbOK_Click()
    Unload UserForm1
End Sub

---

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für Deine Antwort. Damit funktioniert es super und das Makro wird um einiges kürzer. 

Noch eine Frage zu den Unities. Kann ich diese nur einmal an Dich vergeben? Ich wollte Dir auf deine letzte Antwort noch einmal welche schicken, aber irgendwie scheint es nicht zu funktionieren.

Viele Grüße
Torsten

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

---

Hallo Torsten,

du kannst einer Person in einem Thread jeden Wert nur einmal geben, also 1 x 10, 1 x 9 .... 1 x 1. Das heißt du kannst maximal 55 U's vergeben.

Zitat:

---

vielen Dank für Deine Antwort. Damit funktioniert es super und das Makro wird um einiges kürzer.

---

Ich glaube da würde noch einiges mehr gehen was das Kürzen angeht, dass zu erklären würde jetzt aber zu weit führen. 

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

FehlermeldungStartMakro.jpg Erst_BG_Stutzen_Boden.zip

Guten Morgen Bernd,

alles klar, dann weiß ich jetzt wie das mit den Unities funktioniert. 

Ich habe derzeit noch ein ganz komisches Problem mit meinem Makro und ich weiß nicht woran es liegt. 

Manchmal läuft das Makro nicht durch und bringt die Fehlermeldung welche ich als Bild angefügt habe. Wenn ich dann auf Debuggen gehe springt er zur Zeile "Set SelMgr...".

Code:

---

Private Sub CB_BG_erstellen_Click()

            Dim swApp As Object
           
            Dim Part As Object
            Dim boolstatus As Boolean
            Dim longstatus As Long
            Dim longwarnings As Long
            Dim longerrors As Long
           
           
            Dim swAssembly As AssemblyDoc
            Dim swComp As SldWorks.Component
            Dim SelMgr As SelectionMgr
         
            Set swApp = Application.SldWorks
            Set Part = swApp.ActiveDoc
            Set SelMgr = Part.SelectionManager
           

---

Woran kann das liegen? Das kuriose daran ist auch, dass das Makro auch manchmal ohne Probleme und Fehlermeldung durchläuft.

Viele Grüße
Torsten

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

---

Hallo Torsten,

ich könnte mir vorstellen das evtl. dein Part Object "leer" (Nothing) ist. Füge einfach mal die Zeile "Debug.Print Part.GetTitle" unter die Set Part Anweisung ein, und wenn er da dann hängen bleibt ist das Part Object leer und deine Baugruppe war wohl beim Start des Macros nicht aktiv oder so.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,
.
ich habe die Zeile noch in das Makro eingefügt. Bisher läuft alles ohne Fehler. Hab noch einmal vielen Dank für Deine Hilfe. In den letzten Tagen habe ich noch ordentlich was hinzugelernt.

Viele Grüße
Torsten

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

---

Hallo Torsten,

du könntest das Problem mit dem "leeren" Object abfangen in dem du die folgenden Zeilen unter der Set Part Anweisung einfügst.

Code:

---

If Part is Nothing then
MsgBox "Bitte Baugruppe öffnen / aktivieren und Macro erneut starten" vbOkOnly
End
End If

---

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo zusammen,

wir haben derzeit ein Problem mit dem oben erstellten Makro. Sobald das Makro an der Stelle ist, wo mit Hilfe der UserForm ein Element selektieren soll kann man nicht mehr auf Solidworks zugreifen. Beim versuchten anklicken flackert das Fenster der UserForm kurz auf, aber man knn nicht auf die Geometrien, oder irgendetwas anderes, im Solidworks Fenster zugreifen. Das Makro ist bis Ende Dezember ohne Probleme gelaufen. Am System wurde seit dem nichts geändert. Hat jemand eine Idee woran dieses Verhalten liegen kann?

Viele Grüße
Torsten

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

---

Hallo Torsten,

ohne das komplette Makro zu haben wird eine Fehlersuche eher schwer.
Hat nur ein Rechner das Problem oder alle? Kannst du mit sicherheit sagen das niemand was am Makro geändert hat?

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

das Problem besteht an jedem Rechner. Am Makro wurde auch nichts geändert. Deswegen bin ich etwas ratlos. Das Makro startet ganz normal, fügt wie gewünscht Bauteile in eine Baugruppe ein. Wenn dann ein Element im Solidworks angewählt werden soll (was ich über die UserForm, wie von dir beschrieben, gelöst habe), kann man nichts anklicken. Ich kann nur die UserForm schließen und beende damit das Makro.

Viele Grüße
Torsten

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

---

Hallo zusammen,

nachfolgend der betroffene Code des Makros.

Code:

---

Dim swApp As Object
Dim Part As Object
Dim SelMgr As SelectionMgr
Dim swEqnMgr As SldWorks.EquationMgr
                       
Set swApp = Application.SldWorks
           
           
           
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Dim longerrors As Long
           
           
Dim swAssembly As AssemblyDoc
Dim swComp As SldWorks.Component
                     
           
Dim PathNameVorlageBG As String
Dim PathNameRefPart As String
Dim nameNewBG As String
Dim PathNameNewBG As String
Dim PathNameVorlage1 As String              ' Pfad Flansch
Dim NameVorlage1 As String                  ' Name Flansch
Dim NameVorlage1_inBG As String            ' Name Flansch in Bauruppe
Dim DN As String
Dim DNk As String
Dim PNk As String
Dim DN_PN As String
Dim PathNameVorlage2 As String              ' Pfad Stutzenrohr
Dim NameVorlage2 As String                  ' Name Stutzenrohr
Dim NameVorlage2_inBG As String            ' Name Stutzenrohr in Baugruppe
Dim NameNewVorlage1 As String              ' neuer Name Flansch
Dim PathNameNewVorlage1 As String
Dim NameNewVorlage2 As String              ' neuer Name Stutzenrohr
Dim PathNameNewVorlage2 As String
Dim NameNewVorlage1_inBG As String          ' neuer Name Flansch in Baugruppe
Dim NameNewVorlage2_inBG As String          ' neuer Name Stutzenrohr in Baugruppe
Dim NameRefernzPart_inBG As String          ' Name Referenzbauteil in Baugruppe
           
Dim ValueSFlange As Variant
Dim ValueSPipe As Variant
           
txtThicknessFlange = Replace(txtThicknessFlange, ",", ".")
txtThicknessPipe = Replace(txtThicknessPipe, ",", ".")
           
' Auslesen der Vorschriften
Dim VorschriftVorlage1 As String
Dim VorschriftVorlage11 As String
Dim txtNameVorlage1tw As String
Dim SucheVorlage1 As Integer

txtNameVorlage1tw = txtNameVorlage1

SucheVorlage1 = InStr(txtNameVorlage1tw, "___")

txtNameVorlage1tw = Mid(txtNameVorlage1tw, SucheVorlage1 + 3)

SucheVorlage1 = InStr(txtNameVorlage1tw, ".")

VorschriftVorlage1 = Left(txtNameVorlage1tw, SucheVorlage1 - 1)

Dim VorschriftVorlage2 As String
Dim txtNameVorlage2tw As String
Dim SucheVorlage2 As Integer

txtNameVorlage2tw = txtNameVorlage2

SucheVorlage2 = InStr(txtNameVorlage2tw, "___")

txtNameVorlage2tw = Mid(txtNameVorlage2tw, SucheVorlage2 + 3)

SucheVorlage2 = InStr(txtNameVorlage2tw, ".")

VorschriftVorlage2 = Left(txtNameVorlage2tw, SucheVorlage2 - 1)

' Namen und Pfade festlegen
If Right$(txtPathStartVorlage, 1) = "\" Then
    PathNameVorlageBG = txtPathStartVorlage & txtNameStartVorlBG
Else
    PathNameVorlageBG = txtPathStartVorlage & "\" & txtNameStartVorlBG
End If
           
If Right$(txtPathProject, 1) = "\" Then
    PathNameRefPart = txtPathProject & txtNameReferenzPart & ".SLDPRT"
Else
    PathNameRefPart = txtPathProject & "\" & txtNameReferenzPart & ".SLDPRT"
End If
           
nameNewBG = txtNameStutzen & ".SLDASM"
           
If Right$(txtPathProject, 1) = "\" Then
    PathNameNewBG = txtPathProject & nameNewBG
Else
    PathNameNewBG = txtPathProject & "\" & nameNewBG
End If
           
           
If Right$(txtPathVorlage1, 1) = "\" Then
    PathNameVorlage1 = txtPathVorlage1 & txtNameVorlage1 & ".SLDPRT"
Else
    PathNameVorlage1 = txtPathVorlage1 & "\" & txtNameVorlage1 & ".SLDPRT"
End If
           
NameVorlage1 = txtNameVorlage1 & ".SLDPRT"
           
NameVorlage1_inBG = txtNameVorlage1 & "-1@" & txtNameStutzen
           
'If ComboBoxDN < 100 Then
    'DN = "DN 0" & ComboBoxDN
'Else
    DN = "DN " & ComboBoxDN
'End If
           
'If ComboBoxDN < 100 Then
    'DNk = "0" & ComboBoxDN
'Else
    DNk = "" & ComboBoxDN
'End If
           
If ComboBoxPN = 2.5 Then
    DN_PN = DN & " " & "PN 002"
Else
    If ComboBoxPN < 10 Then
        DN_PN = DN & " " & "PN 00" & ComboBoxPN
    Else
        DN_PN = DN & " " & "PN 0" & ComboBoxPN
    End If
End If
           
If ComboBoxPN = 2.5 Then
    PNk = "002"
Else
    If ComboBoxPN < 10 Then
        PNk = "00" & ComboBoxPN
    Else
        PNk = "0" & ComboBoxPN
    End If
End If
                       
If Right$(txtPathVorlage2, 1) = "\" Then
    PathNameVorlage2 = txtPathVorlage2 & txtNameVorlage2 & ".SLDPRT"
Else
    PathNameVorlage2 = txtPathVorlage2 & "\" & txtNameVorlage2 & ".SLDPRT"
End If
           
NameVorlage2 = txtNameVorlage2 & ".SLDPRT"
           
NameVorlage2_inBG = txtNameVorlage2 & "-1@" & txtNameStutzen
           
If CheckBoxRepeatPartFlange = False Then
    NameNewVorlage1 = txtNameStutzen & "_Flansch_DN" & DNk & "_PN" & PNk & "_" & txtThicknessFlange & "_" & VorschriftVorlage1 & ".SLDPRT"
    NameNewVorlage1_inBG = txtNameStutzen & "_Flansch_DN" & DNk & "_PN" & PNk & "_" & txtThicknessFlange & "_" & VorschriftVorlage1 & "-1@" & txtNameStutzen
Else
    NameNewVorlage1 = txtNameVorlage1 & ".SLDPRT"
    NameNewVorlage1_inBG = txtNameVorlage1 & "-1@" & txtNameStutzen
End If
           
If Right$(txtPathProject, 1) = "\" Then
    PathNameNewVorlage1 = txtPathProject & NameNewVorlage1
Else
    PathNameNewVorlage1 = txtPathProject & "\" & NameNewVorlage1
End If
           
If CheckBoxRepeatPartPipe = False Then
    NameNewVorlage2 = txtNameStutzen & "_Stutzenrohr_DN" & DNk & "_PN" & PNk & "_" & txtThicknessPipe & "_" & VorschriftVorlage2 & ".SLDPRT"
    NameNewVorlage2_inBG = txtNameStutzen & "_Stutzenrohr_DN" & DNk & "_PN" & PNk & "_" & txtThicknessPipe & "_" & VorschriftVorlage2 & "-1@" & txtNameStutzen
Else
    NameNewVorlage2 = txtNameVorlage2 & ".SLDPRT"
    NameNewVorlage2_inBG = txtNameVorlage2 & "-1@" & txtNameStutzen
End If

If Right$(txtPathProject, 1) = "\" Then
    PathNameNewVorlage2 = txtPathProject & NameNewVorlage2
Else
    PathNameNewVorlage2 = txtPathProject & "\" & NameNewVorlage2
End If
                       
NameRefernzPart_inBG = txtNameReferenzPart & "-1@" & txtNameStutzen
           
           
' Neue Baugruppe erstellen
Set Part = swApp.NewDocument(PathNameVorlageBG, 0, swSheetWidth, swSheetHeight)
Set swAssembly = Part
swApp.ActivateDoc2 "Baugruppe1", False, longstatus
Set Part = swApp.ActiveDoc
Debug.Print Part.GetTitle
Set SelMgr = Part.SelectionManager
           
           
           
' Referenzbauteil als Hülle in die Baugruppe einfügen (Envelop = Hülle)
Dim swNewEnvelope As Component2
Set swNewEnvelope = Part.InsertEnvelope(PathNameRefPart, "", 1.57643877462214, 1.57940425564975, 1.57971713378014)
Dim TransformData() As Double
ReDim TransformData(0 To 15) As Double
TransformData(0) = 1
TransformData(1) = 0
TransformData(2) = 0
TransformData(3) = 0
TransformData(4) = 1
TransformData(5) = 0
TransformData(6) = 0
TransformData(7) = 0
TransformData(8) = 1
TransformData(9) = 0
TransformData(10) = 0
TransformData(11) = 0
TransformData(12) = 1
TransformData(13) = 0
TransformData(14) = 0
TransformData(15) = 0
Dim TransformDataVariant As Variant
TransformDataVariant = TransformData
Dim swMathUtil As Object
Set swMathUtil = swApp.GetMathUtility()
Dim swTransform As Object
Set swTransform = swMathUtil.CreateTransform((TransformDataVariant))
boolstatus = swNewEnvelope.SetTransformAndSolve2(swTransform)
           
           
           
' Zoom To Fit
Part.ViewZoomtofit2
           
           
           
' Speichern der Bauruppe
Dim swModel1 As ModelDoc2
Set swModel1 = swApp.ActiveDoc
'swModel1.Extension.SaveAs nameNewBG, 0, 1, Nothing, longstatus, longwarnings
swModel1.Extension.SaveAs PathNameNewBG, 0, 1, Nothing, longstatus, longwarnings
           
           
           
' Einfügen Komponente 1
Dim AssemblyTitle As String
Dim tmpObj As ModelDoc2
Dim Errors As Long
Dim swInsertedComponent As Component2
           
           
           
If CheckBoxRepeatPartFlange = False Then
    ' Einfuegen Flansch
    Set tmpObj = swApp.OpenDoc6(PathNameVorlage1, 1, 32, "", longerrors, longwarnings)
    Set swInsertedComponent = Part.AddComponent5(PathNameVorlage1, 0, "", True, DN_PN, -0.608038299754696, -0.603924454331775, -0.6062577503223)
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage1, 0, 1, longerrors, longwarnings)
               
    ValueSFlange = txtThicknessFlange & "mm"
               
    Set Part = swApp.ActiveDoc
    Set swEqnMgr = Part.GetEquationMgr()
               
    ' Gleichungen durchsuchen und die Wanddicke auf eingegebenen Wert ändern
    For i = 0 To swEqnMgr.GetCount - 1
        vSplit = Split(swEqnMgr.Equation(i), "=")
        vSplit(0) = Replace(vSplit(0), Chr(34), Empty)
    If vSplit(0) = "Wanddicke" Then _
        swEqnMgr.Equation(i) = Replace(swEqnMgr.Equation(i), vSplit(1), ValueSFlange)      ' Globale Variable "Wanddicke" mit neuen Wert befüllen
    Next i
   
    boolstatus = Part.EditRebuild3()                                                                ' Bauteil aktualisieren
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage1, 0, 1, longerrors, longwarnings)
                         
    swApp.CloseDoc NameNewVorlage1
    swApp.CloseDoc NameVorlage1
               
    Set Part = swApp.ActiveDoc
    boolstatus = Part.Extension.SelectByID2(NameNewVorlage1_inBG, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    Part.OpenCompFile
   
   
               
    ' Gleichungen durchsuchen und die Wanddicke auf eingegebenen Wert ändern
    For i = 0 To swEqnMgr.GetCount - 1
        vSplit = Split(swEqnMgr.Equation(i), "=")
        vSplit(0) = Replace(vSplit(0), Chr(34), Empty)
    If vSplit(0) = "Wanddicke" Then _
        swEqnMgr.Equation(i) = Replace(swEqnMgr.Equation(i), vSplit(1), ValueSFlange)      ' Globale Variable "Wanddicke" mit neuen Wert befüllen
    Next i
   
    boolstatus = Part.EditRebuild3()                                                                ' Bauteil aktualisieren
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage1, 0, 1, longerrors, longwarnings)
               
    swApp.CloseDoc NameNewVorlage1
               
Else
    ' Einfuegen Flansch
    Set tmpObj = swApp.OpenDoc6(PathNameVorlage1, 1, 32, "", longerrors, longwarnings)
    Set swInsertedComponent = Part.AddComponent5(PathNameVorlage1, 0, "", True, "", -0.608038299754696, -0.603924454331775, -0.6062577503223)
    boolstatus = Part.SaveAs4(PathNameNewVorlage1, 0, 1, longerrors, longwarnings)
                         
    swApp.CloseDoc NameNewVorlage1
    swApp.CloseDoc NameVorlage1
End If
           
           
           
' speichern Componente 1
Set Part = swApp.ActivateDoc3(NameNewVorlage1, True, 0, longerrors)
boolstatus = Part.SaveAs4(PathNameNewVorlage1, 0, 1, longerrors, longwarnings)
Set Part = swApp.ActivateDoc3(nameNewBG, True, 0, longerrors)
swApp.CloseDoc NameNewVorlage1
           
           
           
' Speichern der Bauruppe
Set Part = swApp.ActiveDoc
Set swModel1 = swApp.ActiveDoc
swModel1.Extension.SaveAs PathNameNewBG, 0, 1, Nothing, longstatus, longwarnings
           
           
           
If CheckBoxRepeatPartPipe = False Then
    ' Einfügen Stutzenrohr
    Set tmpObj = swApp.OpenDoc6(PathNameVorlage2, 1, 32, "", longerrors, longwarnings)
    Set swInsertedComponent = Part.AddComponent5(PathNameVorlage2, 0, "", True, DN, -3.18732196575411E-03, -0.250609051215037, -0.50427343450508)
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage2, 0, 1, longerrors, longwarnings)
               
    ValueSPipe = txtThicknessPipe & "mm"
    ValueLPipe = txtLengthPipe & "mm"
               
    Set Part = swApp.ActiveDoc
    Set swEqnMgr = Part.GetEquationMgr()
               
    ' Gleichungen durchsuchen und die Wanddicke auf eingegebenen Wert ändern
    For i = 0 To swEqnMgr.GetCount - 1
        vSplit = Split(swEqnMgr.Equation(i), "=")
        vSplit(0) = Replace(vSplit(0), Chr(34), Empty)
    If vSplit(0) = "Wanddicke" Then _
        swEqnMgr.Equation(i) = Replace(swEqnMgr.Equation(i), vSplit(1), ValueSPipe)            ' Globale Variable "Wanddicke" mit neuen Wert befüllen
    Next i
   
    boolstatus = Part.EditRebuild3()                                                                ' Bauteil aktualisieren
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage2, 0, 1, longerrors, longwarnings)
               
    swApp.CloseDoc NameNewVorlage2
    swApp.CloseDoc NameVorlage2
               
    Set Part = swApp.ActiveDoc
    boolstatus = Part.Extension.SelectByID2(NameNewVorlage2_inBG, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    Part.OpenCompFile
                               
    ' Gleichungen durchsuchen und die Laenge auf eingegebenen Wert ändern
    For i = 0 To swEqnMgr.GetCount - 1
        vSplit = Split(swEqnMgr.Equation(i), "=")
        vSplit(0) = Replace(vSplit(0), Chr(34), Empty)
    If vSplit(0) = "Laenge" Then _
        swEqnMgr.Equation(i) = Replace(swEqnMgr.Equation(i), vSplit(1), ValueLPipe)            ' Globale Variable "Laenge" mit neuen Wert befüllen
    Next i
               
    ' Gleichungen durchsuchen und die Wanddicke auf eingegebenen Wert ändern
    For i = 0 To swEqnMgr.GetCount - 1
        vSplit = Split(swEqnMgr.Equation(i), "=")
        vSplit(0) = Replace(vSplit(0), Chr(34), Empty)
    If vSplit(0) = "Wanddicke" Then _
        swEqnMgr.Equation(i) = Replace(swEqnMgr.Equation(i), vSplit(1), ValueSPipe)            ' Globale Variable "Wanddicke" mit neuen Wert befüllen
    Next i
               
    boolstatus = Part.EditRebuild3()                                                                ' Bauteil aktualisieren
               
    boolstatus = Part.SaveAs4(PathNameNewVorlage2, 0, 1, longerrors, longwarnings)
               
    swApp.CloseDoc NameNewVorlage2
               
Else
    ' Einfügen Stutzenrohr
    Set tmpObj = swApp.OpenDoc6(PathNameVorlage2, 1, 32, "", longerrors, longwarnings)
    Set swInsertedComponent = Part.AddComponent5(PathNameVorlage2, 0, "", True, "", -3.18732196575411E-03, -0.250609051215037, -0.50427343450508)
    boolstatus = Part.SaveAs4(PathNameNewVorlage2, 0, 1, longerrors, longwarnings)
                       
    swApp.CloseDoc NameNewVorlage2
    swApp.CloseDoc NameVorlage2
End If
           
           
           
' Speichern Component 2
Set Part = swApp.ActivateDoc3(NameNewVorlage2, True, 0, longerrors)
boolstatus = Part.SaveAs4(PathNameNewVorlage2, 0, 1, longerrors, longwarnings)
Set Part = swApp.ActivateDoc3(nameNewBG, True, 0, longerrors)
swApp.CloseDoc NameNewVorlage2
           
           
           
' Speichern Baugruppe
Set swModel1 = swApp.ActiveDoc
swModel1.Extension.SaveAs PathNameNewBG, 0, 1, Nothing, longstatus, longwarnings
           
           
           
' Zoom To Fit
Set Part = swApp.ActiveDoc
Part.ViewZoomtofit2
           
           
           
' Verknüpfung Flansch zu Hüllgeometrie
Dim EntitiesToMate(1) As Object
Dim EntitiesToMateVar As Variant
Dim MateData As CoincidentMateFeatureData
Dim MateDataP As ParallelMateFeatureData
Dim MateFeature As Feature
           
' Selektion Punkt in Skizze
Dim rsSPClick As Integer
Dim Anzahl As Variant
Dim sID As Variant
Dim count As Long
Dim swFeatRSS As SldWorks.Feature
Dim swFeatRSSP As Object
Dim swSelDataRSS As SldWorks.SelectData
Dim swSelDataRSSP As SldWorks.SelectData
Dim NameSkizze As String
Dim NamePunkt As String
Dim SkPktBezeichnung As String
               
               
               
NameSkizze = txtNameSketchPosStutzen
boolstatus = Part.Extension.SelectByID2(NameSkizze & "@" & NameRefernzPart_inBG, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.UnblankSketch
               
               
               
Part.ClearSelection2 True
AuswahlRefPkt.Show
               
While AuswahlRefPkt.Visible
    DoEvents
Wend
                                       
Set swFeatRSSP = SelMgr.GetSelectedObject6(1, -1)
Set swSelDataRSSP = SelMgr.CreateSelectData

If swFeatRSSP Is Nothing Then
    MsgBox "Es wurde nichts ausgewählt. Das Makro wird beendet!"
    End
End If
                                                                         
sID = swFeatRSSP.GetID
                                   
NamePunkt = "Punkt" & sID(1)
                   
                   
                   
SkPktBezeichnung = NamePunkt & "@" & NameSkizze & NameRefernzPart_inBG
           
           
           
' Create CoincidentMateFeatureData 1
boolstatus = Part.Extension.SelectByID2(SkPktBezeichnung, "EXTSKETCHPOINT", 0, 0, 0, False, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Mittelachse@" & NameNewVorlage1_inBG, "AXIS", 0, 0, 0, True, 1, Nothing, 0)
Set MateData = Part.CreateMateData(0)
           
' Set the Entities To Mate
Set EntitiesToMate(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
MateData.EntitiesToMate = (EntitiesToMateVar)
           
' Set the Mate Alignment
MateData.MateAlignment = 2
           
' Create the mate
Set MateFeature = Part.CreateMate(MateData)
Part.ClearSelection2 True
Part.EditRebuild3
Part.ClearSelection2 True
           
           
' Create CoincidentMateFeatureData 2
boolstatus = Part.Extension.SelectByID2(txtNameEinfEbene & "@" & NameRefernzPart_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Einfuegeebene_Flansch@" & NameNewVorlage1_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
Set MateData = Part.CreateMateData(0)
           
' Set the Entities To Mate
Set EntitiesToMate(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
MateData.EntitiesToMate = (EntitiesToMateVar)
           
' Set the Mate Alignment
MateData.MateAlignment = 0
           
' Create the mate
Set MateFeature = Part.CreateMate(MateData)
Part.ClearSelection2 True
Part.EditRebuild3
           
' Create ParallelMateFeatureData 3
boolstatus = Part.Extension.SelectByID2("Ebene rechts@" & NameRefernzPart_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Ebene_Verdrehung@" & NameNewVorlage1_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
Set MateDataP = Part.CreateMateData(3)
           
' Set the Entities To Mate
Dim EntitiesToMateP(1) As Object
Set EntitiesToMateP(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMateP(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
Dim EntitiesToMateVarP As Variant
EntitiesToMateVarP = EntitiesToMateP
MateDataP.EntitiesToMate = (EntitiesToMateVarP)
           
' Set the Mate Alignment
MateDataP.MateAlignment = 0
           
' Create the mate
Dim MateFeatureP As Feature
Set MateFeatureP = Part.CreateMate(MateDataP)
Part.ClearSelection2 True
Part.EditRebuild3
           
           
           
' Speichern Baugruppe
boolstatus = Part.Save3(1, longerrors, longwarnings)
           
           
           
' Verknüpfungen zwischen Flansch und Stutzenrohr
boolstatus = Part.Extension.SelectByID2("Einfuegeebene_Anschluss@" & NameNewVorlage1_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Einfuegeebene_oben@" & NameNewVorlage2_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
           
' Create CoincidentMateFeatureData
Set MateData = Part.CreateMateData(0)
           
' Set the Entities To Mate
Set EntitiesToMate(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
MateData.EntitiesToMate = (EntitiesToMateVar)
           
' Set the Mate Alignment
MateData.MateAlignment = 0
           
' Create the mate
Set MateFeature = Part.CreateMate(MateData)
Part.ClearSelection2 True
Part.EditRebuild3
           
boolstatus = Part.Extension.SelectByID2("Mittelachse@" & NameNewVorlage1_inBG, "AXIS", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Mittelachse@" & NameNewVorlage2_inBG, "AXIS", 0, 0, 0, True, 1, Nothing, 0)
           
' Create CoincidentMateFeatureData
Set MateData = Part.CreateMateData(0)
           
' Set the Entities To Mate
Set EntitiesToMate(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
MateData.EntitiesToMate = (EntitiesToMateVar)
           
' Set the Mate Alignment
MateData.MateAlignment = 0
           
' Create the mate
Set MateFeature = Part.CreateMate(MateData)
Part.ClearSelection2 True
Part.EditRebuild3
           
boolstatus = Part.Extension.SelectByID2("Ebene_Verdrehung@" & NameNewVorlage1_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Ebene_Verdrehung@" & NameNewVorlage2_inBG, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
           
' Create CoincidentMateFeatureData
Set MateData = Part.CreateMateData(0)
           
' Set the Entities To Mate
Set EntitiesToMate(0) = Part.SelectionManager.GetSelectedObject6(1, -1)
Set EntitiesToMate(1) = Part.SelectionManager.GetSelectedObject6(2, -1)
EntitiesToMateVar = EntitiesToMate
MateData.EntitiesToMate = (EntitiesToMateVar)
           
' Set the Mate Alignment
MateData.MateAlignment = 0
           
' Create the mate
Set MateFeature = Part.CreateMate(MateData)
Part.ClearSelection2 True
Part.EditRebuild3
           
           
           
' Speichern
boolstatus = Part.Save3(1, longerrors, longwarnings)

---

Das Problem ist ab "' Selektion Punkt in Skizze". Dort wird die UserForm geöffnet und ein Punkt in einer Skizze soll angewählt werden.
Hat jemand eine Idee warum die Selektion auf einmal nicht mehr möglich ist?

Viele Grüße
Torsten

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

---

Hallo Torsten,

lade doch bitte das Macro hoch (einfach .txt am Ende dran hängen) da könnte man dann auch deine Eigenschaften der UserForm überprüfen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

das Makro kann ich leider erst in 2 Wochen hochladen. Bin derzeit im Urlaub und der einzige der die vorbelegten Variablen so ändern kann das nichts Firmeninternes mehr enthalten ist.
Oder weißt du wie man das Makro außerhalb von Solidworks öffnen und bearbeiten kann?

Viele Grüße
Torsten

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

---

Hallo Torsten,

außerhalb von SWX lassen sich VBA Macros leider nicht öffnen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

das hatte ich schon fast befürchtet. Sobald ich wieder auf Arbeit bin lade ich das Makro hoch.
Bis dahin erst einmal vielen Dank für Deine Mühe.

Viele Grüße
Torsten

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

---

Erst_BG_Stutzen_Boden_m_BF_20191203.zip

Hallo zusammen,

im Anhang befindet sich das komplette Makro. Vielleicht weiß jemand warum es auf einmal nicht mehr funktioniert.

Viele Grüße
Torsten

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

---

Hallo Torsten,

wenn ich das Macro öffne sind alle UserForms die zum selektieren auffordern gebunden (ShowModal = True) diese sollten doch ungebunden sein (ShowModal = False).

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

das war das Problem. Jetzt funktioniert das Makro wieder wie es soll. Vielen Dank für Deine Hilfe!

Viele Grüße
Torsten

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

---

Hallo Torsten,

dann ist es ja perfekt, wundert mich nur das die Eigenschaft geändert wurde, da du sagtes am Macro wurde eigentlich nicht geändert.    .

Ich würde dir mal raten dein Macro ein wenig aufzuräumen, deine Struktur ist eher so meh und du wechselst auch gerne mal zwischen early und late binding (für dich als Anfänger ist early binding sinnvoller).

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

ja mit der Struktur habe ich noch so meine Probleme. Was meinst du mit early und late binding?  Das sagt mir leider gar nichts. 

Viele Grüße
Torsten

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

---

Hallo Torsten,

"Early binding" heißt du deklarierst deine Variblen vorher und legst den genauen Type fest z.B.

Code:

---

Dim swModal As ModelDoc2 '<- Hier wird der Objecttyp ModelDoc2 festgelegt
Set swModel = swApp.ActiveDoc '<- Der Rückgabewert ModelDoc2 wird von der Methode erwartet

---

"Late binding" heißt du lässt denn Code den genauen Type erst zur Laufzeit festlegen z.B.

Code:

---

Dim swModel As Object '<- Hier wird fesgelegt das es sich um ein beliebiges Object handelt
Set swModel = swApp.ActiveDoc '<- Ein beliebiges Object wird als Rückgabewert erwartet

---

Die Vorteil für Anfänger beim Early binding sind:
- beim Kompilieren des Codes werden die erwarteten Objecttypen und Methoden gegengeprüft
- du kannst Intellisens für diese Variablen verwenden, dass heist dir werden nur die passenden Methoden (Eigenschaften) für die Objecte vorgeschlagen (siehe Bild)
- macht den Code einfacher lesbar, weil jeder schneller sehen kann was wo erwartet wird

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo Bernd,

vielen Dank für Deine Erläuterungen. Jetzt weiß ich was mit early und late binding gemeint ist.
Derzeit ist bei mir auf Arbeit ziemlich viel los. Sobald es wieder etwas ruhiger ist werde ich auf jeden Fall noch einmal das Makro entsprechend überarbeiten.

Viele Grüße
Torsten

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