---

Hallo
habe ein Makro aufgezeichnet. Leider funktioniert es nicht wenn ich es ausführe.
Es geht um eine Längenänderung eines Features von 500mm auf 700mm.
Ich verstehe auch nicht weshalb die 700 im Code auch nicht angezeigt werden. An was liegt das?
Hier der Code:

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.Extension.SelectByID2("Aufsatz-Linear austragen1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ActivateSelectedFeature
boolstatus = Part.Extension.SelectByID2("D1@Aufsatz-Linear austragen1@Teil1.SLDPRT", "DIMENSION", 2.27494232343363E-02, 6.19530769993834E-03, -0.010034508136583, True, 0, Nothing, 0)
boolstatus = Part.EditRebuild3()
End Sub

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

---

Hallo,

weil er die Änderung überhaupt nicht aufgezeichnet hat.

Er wählt nur zweimal das Feature/Bauteil aus.

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

---

Hallo

Die Makroaufzeichnung zeichnet nicht alles auf und es enthält oft Redundanzen.

Ich habe dein Makro einmal umgeschrieben, damit er genau das macht, was du aufzeichnen wolltest.

Code:

---

Sub ChangeFeatureDimension()
    Dim swApp As SldWorks.ISldWorks
    Dim swModel As SldWorks.IModelDoc2
    Dim swSelMgr As SldWorks.ISelectionMgr
    Dim swFeat As SldWorks.IFeature
    Dim swDim As SldWorks.IDimension
    Dim newDimensionValue As Double
   
    ' Öffne das aktive Modell
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then Exit Sub
   
    ' Wähle das gewünschte Feature (z. B. eine Bohrung)
    'Set swSelMgr = swModel.SelectionManager
    'Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
    Set swFeat = swModel.FeatureByName("Aufsatz-Linear austragen1")
   
    If swFeat Is Nothing Then Exit Sub
   
    ' Wähle die gewünschte Bemassung
    Set swDim = swFeat.Parameter("D1")
    If swDim Is Nothing Then Exit Sub
   
    ' Benutzerdefinierte Eingabe für das neue Mass
    newDimensionValue = InputBox("Neue Grösse eingeben (in mm):", "Feature-Mass ändern", swDim.Value)
   
    ' Ändere das Mass
    swDim.SystemValue = newDimensionValue / 1000 ' Umrechnung von mm in Meter
   
    ' Aktualisiere das Modell
    swModel.EditRebuild3
   
    ' Optional: Zeige eine Erfolgsmeldung an
    MsgBox "Feature-Mass erfolgreich geändert!", vbInformation, "Erfolg"
End Sub

---

Sei bedacht, dass dieses nur funktioniert, wenn dein Teil ein Feature "Aufsatz-Linear austragen1" und dieses das Mass "D1" enthält.

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

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

---

@R3vo

An was kann das liegen, dass da nicht richtig bzw unvollständig aufgezeichnet wird?

@HenryV

Vielen Dank für die Hilfe, dass hilft mir fürs erste sicher mal weiter.

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

---

Baugruppe.PNG

@HenryV

Nun habe ich schon die nächste Frage.

Wie editiere oder wähle ich das Bauteil in einer Baugruppe oder gar Unterbaugruppe aus?

Ich frage mich warum der Makrorekorder das nicht aufzeichnen kann, dann müsste ich es nur editieren. Wäre deutlich leichter.

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

---

Zitat:

---

Original erstellt von Scoopa:
... Ich frage mich warum der Makrorekorder das nicht aufzeichnen kann ...

---

Hallo,

"Warum" ist vermutlich schwierig zu beantworten,
Aber es ist schon länger so ...  hast du hier schon mal zu lesen begonnen? ...
http://solidworks.cad.de/apitut.htm

Auswählen in Baugruppe - da gibt es rekursive oder nicht rekursive Beispiele durch alle Komponenten ...

Gruß, Christian

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

---

Zitat:

---

Original erstellt von Scoopa:
Wie editiere oder wähle ich das Bauteil in einer Baugruppe oder gar Unterbaugruppe aus?

---

Falls du das Feature vor dem Start des Makros mit der Maus auswählen willst, ganz einfach.
Ändere diese Zeilen

Code:

---

' Wähle das gewünschte Feature (z. B. eine Bohrung)
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
'Set swFeat = swModel.FeatureByName("Aufsatz-Linear austragen1")

---

Wenn du das dynamisch habe willst, wird des schnell kompliziert mit diversem Traversieren des Feature-Managers.

Dann musst du dein Teil im Feature-Manager suchen. Traversing the components tree
Dann musst du dein Feature im Feature-Managers des Teils suchen. Find features in the tree by type and/or name pattern
Dann musst du deine Bemassung suchen. Traverse all dimensions of component or model

Aber bevor du mit programmieren beginnst -> Is It Worth the Time?

------------------
21 ist nur die halbe Antwort.

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

---

BauteilSkizzeeditieren.png

@HenryV

könntest Du  mir nochmal eine Starthilfe geben?
Wie editiere ich das Mass 50 "D2@Skizze1" siehe Bild im Feature "Aufsatz Linear austragen1" vom Bauteil "Teil1"
Danach sollte ich vermutlich wieder alleine zurecht kommen. 
Vielen Dank im voraus!

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

---

Ich glaube ich habe einen Ansatz :-)

Option Explicit
Dim part As Object
Dim swApp As Object

Private Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc
part.Parameter("D2@Skizze1@Teil1.Part").SystemValue = 0.0254
part.EditRebuild
part.ClearSelection
End Sub

Das Mass wird auf 25,40 geändert.

Hier wird mir das Feature geändert

Dim swApp As Object

Option Explicit

Sub Main()

Dim part As Object
Dim swApp As Object

Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc
part.Parameter("D1@Aufsatz-Linear austragen1@Teil1.Part").SystemValue = 1#
part.EditRebuild
part.ClearSelection
End Sub

[Diese Nachricht wurde von Scoopa am 14. Mrz. 2024 editiert.]

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

---

Code:

---

Sub ChangeFeatureDimension()
    Dim swApp As SldWorks.ISldWorks
    Dim swModel As SldWorks.IModelDoc2
    Dim swDim As SldWorks.IDimension
    Dim newDimensionValue As Variant 'Double
   
    ' Öffne das aktive Modell
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then Exit Sub
       
    ' Wähle die gewünschte Bemaßung (z. B. Durchmesser)
    Set swDim = swModel.Parameter("D2@Skizze1")
    If swDim Is Nothing Then Exit Sub
   
    ' Benutzerdefinierte Eingabe für das neue Maß
    newDimensionValue = InputBox("Neue Größe eingeben (in mm):", "Feature-Maß ändern", swDim.Value)
    If newDimensionValue = "" Or Not IsNumeric(newDimensionValue) Then Exit Sub

    ' Ändere das Maß
    swDim.SystemValue = newDimensionValue / 1000 ' Umrechnung von mm in Meter
   
    ' Aktualisiere das Modell
    swModel.EditRebuild3
   
    ' Optional: Zeige eine Erfolgsmeldung an
    MsgBox "Feature-Maß erfolgreich geändert!", vbInformation, "Erfolg"
End Sub

---

------------------
21 ist nur die halbe Antwort.

[Diese Nachricht wurde von HenryV am 14. Mrz. 2024 editiert.]

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

---

BauteilSkizzeeditieren_userform.png

Ich habe ein Makro geschrieben zum Ändern einer Länge

nach Ausführen des Makros auf den Button wird die Skizze nicht aktualisiert und es wird automatisch in der Textbox eine 0 eingetragen.

Woran kann das liegen? Ich komme leider nicht drauf.

Private Sub CommandButton1_Click()
Dim part As Object
Dim swApp As Object
Dim Length As Integer
Dim LengthReal As Integer

UserForm1.TextBox1.Value = Length

LengthReal = Length \ 1000

Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc
part.Parameter("D2@Skizze1@Teil1.Part").SystemValue = LengthReal '0.0254
part.EditRebuild
part.ClearSelection
End Sub

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

---

Habe den Datentyp der Variablen auf Double geändert. Da das vermutlich auch ein Fehler war.
Brachte aber auch keinen Erfolg  

Das Richtigstellen des Geteiltzeichens zu / brachte leider auch keinen Erfolg

[Diese Nachricht wurde von Scoopa am 18. Mrz. 2024 editiert.]

[Diese Nachricht wurde von Scoopa am 18. Mrz. 2024 editiert.]

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

---

Ich habe es 

die Übergabe in die Variable war falsch

Private Sub CommandButton1_Click()

Dim part As Object
Dim swApp As Object
Dim Length As Variant
Dim LengthReal As Variant

'UserForm1.TextBox1.Value = Length

Length = UserForm1.TextBox1.Value

LengthReal = Length / 1000

Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc
part.Parameter("D2@Skizze1@Teil1.Part").SystemValue = LengthReal '0.0254
part.EditRebuild
part.ClearSelection
End Sub

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

---

Glückwunsch 
und danke, dass du deine Lösung auch gleich postest.

ich würd vermutlich die Textbox umbenennen, vielleicht "TextBox_Length_mm"

Dann könnten einige Zeilen entfallen und die Zuweisung wäre imho immer noch verständlich

Code:

---

part.Parameter("D2@Skizze1@Teil1.Part").SystemValue = _
    UserForm1.TextBox_Length_mm.Value / 1000

---

Typ variant würde ich persönlich nicht bevorzugt nehmen, wenn der Typ eigentlich klar ist als integer oder double oder ...
(eine Beschreibung der Typen hier)
Variant nehme ich gerne für Schleifen mit "for each xxx in xyz"

BTW - wenn du code hier reinschreibst, kannst du ihn mit der Formatierung als Code (links neben dem Textfeld) auch leichter erkennbar machen ...

Ach ja - und hast du schon einen Plan, was passiert, wenn dein Teil anders heisst?
Henry hatte sich ja schon recht viel Mühe gegeben ...

Gruß, Christian

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