Hallo ihr alle
Ich brauche Hilfe, um ein Makro zu erstellen, da mein Wissen in diesem Bereich fast nicht vorhanden ist, habe ich vom ersten Schritt an Schwierigkeiten.
Normalerweise schaffe ich es, so gut es geht, indem ich Teile von rechts und links kopiere, aber hier finde ich nichts, was zumindest am Anfang danach aussieht.
Der Zweck des Makros besteht darin, bestimmte benutzerdefinierte Eigenschaften von einem Teil in eine Baugruppe zu kopieren.
1 - Bedingung: sich in einer Baugruppe befinden
2 - Definieren Sie das ausgewählte Bauteil im Konstruktionsbaum als Quelle der Eigenschaften.
3 - Lesen Sie die Eigenschaft "REFERENCE" des ausgewählten Teils
4 - Zeigen Sie den Wert der Eigenschaft an und wählen Sie aus, ob Sie fortfahren oder abbrechen möchten
5 - Schreiben Sie die Eigenschaft "REFERENCE" in die aktuelle Assembly
6 - Ende
Im Moment stecke ich bei Schritt 2 fest, weil ich nicht weiß, wie die zu verwendende Funktion aufgerufen werden kann.
Wenn mir jemand den richtigen Weg weisen kann,
Vielen Dank im Voraus.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set SwModel = swApp.ActiveDoc 'on récupére le document actif
' Vérifie qu'il s'agit d'un assemblage
If SwModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 "Ne Fonctionne qu'avec un ASSEMBLAGE!", swMbWarning, swMbOk
Exit Sub
End If
End Sub
Hallo
Für die Punkte 2 und 3 können Sie den folgenden Code verwenden:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Debug.Print ValOut
Debug.Print ResolvedValOut
End If
End Sub
Herzliche Grüße
1 „Gefällt mir“
Hallo nochmal,
Für Punkt 4 können Sie den folgenden Code verwenden:
Dim Rep As Integer
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
' ici le traitement si réponse positive
' ...
Else
' ici le traitement si réponse négative
' ...
End If
Herzliche Grüße
1 „Gefällt mir“
Hallo nochmal,
Hier also ein Beispiel für die Punkte 2 - 3 - 4 - 5 und 6:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Else
MsgBox "Aucune sélection."
Exit Sub
End If
Dim Rep As Integer
Dim result As String
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Delete2("REFERENCE")
Retval = swCustPropMgr.Add2("REFERENCE", swCustomInfoText, ResolvedValOut)
result = "Modification effectuée."
Else
result = "Aucune modification effectuée."
End If
MsgBox result
End Sub
Herzliche Grüße
2 „Gefällt mir“
Re-re--.......
Eine kleine zusätzliche Information, die ausgewählte Komponente muss sich im aufgelösten Modus befinden, sonst funktioniert sie nicht, Sie müssen diese Komponente dann in den aufgelösten Modus vor der Zeile "Set swModelDocExt = swSelModel.Extension" setzen, die sich in der Zeile "If Not swSelComp Is Nothing Then" befindet.
Herzliche Grüße
1 „Gefällt mir“
Hallo @d.roger
Danke für Ihre Hilfe, ich schaue es mir diese Woche an,
@d.Roger,
Ich hatte heute nicht viel Zeit, aber ich werde noch mehr Fragen haben :-)
Hallo an alle
Ich bin zurück mit meinen Fragen,
Gibt es eine Lösung, um mehrere benutzerdefinierte Eigenschaften abzurufen, ohne die Anzahl der Variablen "Retval, ValOut ... »Um so viel?
Meine andere Frage ist, ob es möglich ist, die Kopiereigenschaften auf alle Konfigurationen der Assembly anzuwenden, unabhängig vom Namen der Konfigurationen.
Vielen Dank im Voraus,
Gute Nacht.
Hallo
" Gibt es eine Lösung, um mehrere benutzerdefinierte Eigenschaften abzurufen, ohne die Anzahl der Variablen zu multiplizieren?" Retval, ValOut ... »Um so viel? ": Ja, Sie müssen eine Schleife beim Lesen von benutzerdefinierten Eigenschaften machen und diejenigen, an denen Sie interessiert sind, in einem Array hinzufügen, siehe HIER.
" Meine andere Frage ist, ob es möglich ist, die Kopiereigenschaften auf alle Konfigurationen der Baugruppe anzuwenden, unabhängig vom Namen der Konfigurationen. ": Ja, Sie müssen auch eine Schleife für die Konfigurationen der Assembly erstellen, in der Sie Ihren Code ablegen, um Eigenschaften zu erstellen, siehe HIER für die Funktion zum Auflisten der Konfigurationen.
Herzliche Grüße
1 „Gefällt mir“
Hallo @ d.roger,
Vielen Dank für die Info für die Seite "développez.com", die mir sicher gut helfen wird.
Herzliche Grüße.
Hallo
Nachdem die Flaute bei der Arbeit schnell vorbei war, hatte ich keine Zeit, das Makro fortzusetzen, ich erhielt die letzte Antwort von @D.Roger als Lösung, weil die vorgeschlagenen Links sehr interessant sind.
Ich hoffe, dass ich das Makro bald abschließen kann,