| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | AMB |
Autor
|
Thema: Per Makro Skizzenpunkte und Flächen in einer Baugruppe selektieren (3298 mal gelesen)
|
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 04. Sep. 2019 12:33 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 04. Sep. 2019 15:25 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 04. Sep. 2019 15:34 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 04. Sep. 2019 17:34 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 05. Sep. 2019 09:14 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 05. Sep. 2019 12:20 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 05. Sep. 2019 13:32 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 05. Sep. 2019 16:17 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 06. Sep. 2019 06:58 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 06. Sep. 2019 14:19 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 09. Sep. 2019 07:40 <-- editieren / zitieren --> Unities abgeben:
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 09. Sep. 2019 14:51 <-- editieren / zitieren --> Unities abgeben:
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 09. Sep. 2019 14:53 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 09. Sep. 2019 17:09 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 10. Sep. 2019 07:56 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 10. Sep. 2019 08:28 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 10. Sep. 2019 13:25 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 10. Sep. 2019 17:14 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 11. Sep. 2019 07:22 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 11. Sep. 2019 09:23 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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.ShowWhile 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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 11. Sep. 2019 14:52 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 11. Sep. 2019 15:10 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 12. Sep. 2019 07:33 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 12. Sep. 2019 11:08 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 12. Sep. 2019 14:44 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 12. Sep. 2019 17:49 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 17. Jan. 2020 13:15 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 17. Jan. 2020 14:09 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 17. Jan. 2020 17:58 <-- editieren / zitieren --> Unities abgeben:
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 20. Jan. 2020 11:34 <-- editieren / zitieren --> Unities abgeben:
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 IntegertxtNameVorlage1tw = 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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 20. Jan. 2020 14:08 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 20. Jan. 2020 16:27 <-- editieren / zitieren --> Unities abgeben:
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 |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 21. Jan. 2020 13:25 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 21. Jan. 2020 17:35 <-- editieren / zitieren --> Unities abgeben:
|
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 03. Feb. 2020 06:46 <-- editieren / zitieren --> Unities abgeben:
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 03. Feb. 2020 14:05 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 03. Feb. 2020 16:19 <-- editieren / zitieren --> Unities abgeben:
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 04. Feb. 2020 14:10 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 05. Feb. 2020 08:42 <-- editieren / zitieren --> Unities abgeben:
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 05. Feb. 2020 09:33 <-- editieren / zitieren --> Unities abgeben: Nur für Thor16
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 |
Thor16 Mitglied Konstrukteur
Beiträge: 82 Registriert: 27.08.2019 SolidWorks 2022 Windows 10 x64
|
erstellt am: 05. Feb. 2020 13:06 <-- editieren / zitieren --> Unities abgeben:
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|