---

2023-07-2613_56_37-Window.png 2023-07-2613_57_19-Window.png

Hallo,
ich habe ein großes Problem.

Mit meinem Makkro erstelle ich bei SolidWorks2020 verschiedene Konfigurationen und rufe diese in der Zeichnung auf.
Jedoch versuche ich ebenfalls mit diesem Makkro die Bemaßung auf der Zeichnung ausrichten möchte, so dass diese Normgerecht bei jeder Konfiguration erscheint.
Dies funktioniert mit dem aktuellen Code nicht (siehe Anhang).

Kennt jemand eine Möglichkeit das Problem zulösen?

Hier der aktuelle Code:
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawModel As SldWorks.DrawingDoc ' Verwenden Sie die DrawingDoc-Schnittstelle für Zeichnungsdokumente
Dim d As Double ' Durchmesser der Schraube

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.OpenDoc("W:\Tanja\Praxisphase\Tubus\EVO.sldprt", swDocPART)

    If Not swModel Is Nothing Then
        ' Als neue Konfiguration speichern
        Dim swConfMgr As SldWorks.ConfigurationManager
        Dim swConf As SldWorks.Configuration
        Dim newConfName As String

        newConfName = InputBox("Geben Sie den Namen der neuen Konfiguration ein:")
        Set swConfMgr = swModel.ConfigurationManager

        Set swConf = swConfMgr.AddConfiguration(newConfName, "", "", False, True, True)
        swModel.ShowConfiguration2 newConfName

        ' Parameter festlegen, die geändert werden sollen
        Dim dT As Double
        Dim dE As Double
        Dim db As Double
        Dim te As Double
        Dim tc As Double
        Dim ts As Double
        Dim Boden As Double
        Dim Grund As Double
        Dim Grund2 As Double
        Dim Breite As Double

        ' Durchmesser der Schraube abfragen
        d = CDbl(InputBox("Geben Sie den Schraubendurchmesser ein [mm]"))

        ' Verhältnisse bestimmen
        ts = (0.1 * d) / 1000
        te = (2 * d) / 1000
        tc = (0.5 * d) / 1000
        dE = (1.05 * d) / 1000
        db = (0.85 * d) / 1000
        dT = (2 * d) / 1000
        Grund = (d * 4) / 1000
        Grund2 = (d * 4) / 1000
        Breite = ((4 * d) - 3) / 1000
        Boden = (0.5 * d) / 1000

        ' Maße im Modell ändern
        swModel.Parameter("dT@Skizze4").SystemValue = dT
        swModel.Parameter("dE@Skizze4").SystemValue = dE
        swModel.Parameter("db@Skizze4").SystemValue = db
        swModel.Parameter("te@Skizze4").SystemValue = te
        swModel.Parameter("tc@Skizze4").SystemValue = tc
        swModel.Parameter("ts@Skizze4").SystemValue = ts
        swModel.Parameter("Boden@Skizze4").SystemValue = Boden
        swModel.Parameter("Grund@Skizze4").SystemValue = Grund
        swModel.Parameter("Grund2@Skizze5").SystemValue = Grund2
        swModel.Parameter("Breite@Skizze5").SystemValue = Breite

        ' Modell neu aufbauen
        swModel.ForceRebuild3 False

        ' Skizzenelemente positionieren
        PositionSketchDimensions newConfName
    Else
        MsgBox "Fehler beim Öffnen des Modells."
    End If
End Sub

Sub PositionSketchDimensions(newConfName As String)
    Dim drawingPath As String
    drawingPath = "W:\Tanja\Praxisphase\Tubus\EVO.slddrw" ' Aktualisieren Sie den Pfad zur Zeichnungsdatei

    ' Zeichnungsdokument anhand des Pfads öffnen
    Dim swDrawModel As SldWorks.DrawingDoc
    Set swDrawModel = swApp.OpenDoc6(drawingPath, swDocumentTypes_e.swDocDRAWING, swOpenDocOptions_e.swOpenDocOptions_LoadModel, "", 0, 0)

    If Not swDrawModel Is Nothing Then
        ' Das Referenzmodell in der Zeichenansicht suchen und Maßstab festlegen
        Dim swDrawView As SldWorks.View
        Set swDrawView = swDrawModel.GetFirstView

        Dim scaleFactor As Double ' Declare scaleFactor outside the loop to avoid redundant calculations
        Dim updateDimensions As Boolean ' Flag to determine if dimensions need to be updated

        ' Calculate the scale factor only once before the loop
        If d < 3.5 Then
            scaleFactor = 10
        ElseIf d < 6 Then
            scaleFactor = 8
        ElseIf d < 8.5 Then
            scaleFactor = 6
        ElseIf d < 10 Then
            scaleFactor = 4
        Else
            scaleFactor = 3
        End If

        ' Set the correct configuration for the drawing view
        swDrawView.ReferencedConfiguration = newConfName

        ' Set the scale factor for the drawing view
        swDrawView.ScaleDecimal = scaleFactor

        Do While Not swDrawView Is Nothing
            If swDrawView.GetReferencedModelName = swModel.GetPathName Then
                ' Suppress automatic rebuilds during the loop
                swModel.ForceRebuild3 False

                ' Update configuration only if it has changed
                If swDrawView.ReferencedConfiguration <> newConfName Then
                    swDrawView.ReferencedConfiguration = newConfName
                    updateDimensions = True
                End If

                ' Apply the new scale factor only if it has changed
                If swDrawView.ScaleDecimal <> scaleFactor Then
                    swDrawView.ScaleDecimal = scaleFactor
                    updateDimensions = True
                End If
               
                 ' Set scale 2:1 for "Zeichenansicht2" (only if it exists in the drawing)
                If swDrawView.Name = "Zeichenansicht2" Then
                    Dim targetScale As Double
                    If d < 3.5 Then
                        targetScale = 3
                    ElseIf d < 6 Then
                        targetScale = 2
                    ElseIf d < 10 Then
                        targetScale = 1
                    Else
                        targetScale = 1
                    End If

                    If swDrawView.ScaleDecimal <> targetScale Then
                        swDrawView.ScaleDecimal = targetScale
                        updateDimensions = True
                    End If
                End If

                ' Anpassen der Bemaßung an den Ansichtsrahmen
                Dim swAnn As SldWorks.annotation
                Set swAnn = swDrawView.GetFirstAnnotation2

                While Not swAnn Is Nothing
                    ' Überprüfen, ob die Bemaßung eine lineare Bemaßung ist
                    If swAnn.GetType = swLinearDimension Then
                        ' Berechnen der neuen Position der Bemaßung
                        Dim x As Double, y As Double
                        x = swAnn.GetXPosition
                        y = swAnn.GetYPosition

                        ' Hier passen Sie den Wert 7 an den gewünschten Abstand an
                        ' Berechnen der neuen Position der Bemaßung mit Abstand vom Ansichtsrahmen
                        x = x - (7 / 1000) * scaleFactor ' Umrechnung von Millimeter in Meter (Maßeinheit in SOLIDWORKS)
                        y = y - (7 / 1000) * scaleFactor ' Umrechnung von Millimeter in Meter (Maßeinheit in SOLIDWORKS)

                        ' Setzen der neuen Position der Bemaßung
                        swAnn.SetPosition2 x, y, 0
                    End If
                    Set swAnn = swAnn.GetNext2
                Wend
            End If
            Set swDrawView = swDrawView.GetNextView
        Loop
        'Rebuild the drawing document after all views have been updated
        swDrawModel.ForceRebuild
    Else
        MsgBox "Fehler beim Öffnen der Zeichnung."
    End If
End Sub

Function ExtractModelPathFromDrawingView(drawView As SldWorks.View) As String
    Dim modelPath As String
    Dim swDrawModel As SldWorks.ModelDoc2
    Dim swDrawView As Object
    Set swDrawView = drawView

    If Not swDrawView Is Nothing Then
        Set swDrawModel = swDrawView.ReferencedDocument

        If Not swDrawModel Is Nothing Then
            modelPath = swDrawModel.GetPathName()
            ExtractModelPathFromDrawingView = modelPath
        Else
            MsgBox "Fehler beim Abrufen des referenzierten Modells."
        End If
    Else
        MsgBox "Fehler beim Abrufen der Zeichnungsansicht."
    End If
End Function

Vielen Dank im Vorraus. Ich hoffe Ihr könnt mir helfen.

[Diese Nachricht wurde von Tanny am 26. Jul. 2023 editiert.]

[Diese Nachricht wurde von Tanny am 26. Jul. 2023 editiert.]

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

---

Hi Tanja,

was genau klappt denn bei dir nicht, das Ändern der Maße im 3D Modell, das Aktualisieren der Maße im 2D oder das Positionieren der Maße im 2D?

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

---

Das Platzieren auf der 2D Zeichnung klappt leider nicht, die Bemaßung wird aus dem 3D Model gezogen.

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

---

Guten morgen Tanja,

Dadurch, dass du ja keine neuen Ansichten an der Zeichnung vornimmst, würde ich dir nicht Empfehlen neue Maße ins 2D zu importieren. Der einfachste Weg ist, wenn du dein Referenzmodell einmalig manuell mit den benötigten Abmaßen versiehst.
Durch Öffnen von Zeichnung und Bauteil kannst du einfach nur die Werte im 3D manipulieren und die Maße aktualisieren sich in der Zeichnung automatisch.
Falls das mit der Versionierung Probleme gibt, besteht auch die Möglichkeit, das Bauteil, auf welchem die Referenzzeichnung beruht, durch die Methode "replace" auszutauschen. Das Aktualisieren der Maße dürfte hierbei ebenfalls kein Problem sein.

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

---

Guten Morgen,

das Problem ist das ich nicht jede Zeichnung per Hand erstellen kann da ich nicht jeden mm erstellen will, sondern die Zeichnung automatisch mit dem Makro erstellt werden soll. Denn zum Schluss sollen alle Maße mit dem Makro gesteuert und so das Bauteil sowie Zeichnung erstellt werden. Desweg hatte ich geholft es es da eine Lösung gibt aber wenn nicht sieht es so aus das ich feste Größen hab und 20 Varianten des Makros... 

Aber vielen Dank für die Hilfe

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

---

Hi Tanja,

ich glaube du hast mich falsch verstanden. Das was du mit deinem Makro tust ist meinem Verständnis nach eine Variantenkonstruktion, d.h. die Proportionen und die Grundlegende Geometrie bleiben gleich, ändern sich aber bedingt mit der Änderung des Durchmessers, stimmt's?

Weil dann ist es möglich, dass du ein 3D Modell erstellst und dazu eine Referenzzeichnung mit den Maßen erstellst. Wenn du nun deine Parameter für die Maße im 3D Modell über dein Makro änderst, ändern sich  die manuell erstellten Maße beim Öffnen der Zeichnung automatisch und du müsstest dies nur noch als neue Version speichern.

D.h. die Prozess würde so aussehen, hier werden die Zeichnungen aber immer wieder überschrieben, da alle Zeichnungen auf den letzten Speicherstand deines 3D Modells referenzieren würden:
1. Öffne 3D Modell
2. Passe die Maße im 3D Modell an
3. Öffne die Zeichnung
4. Speichern von Zeichnung und 3D Modell -> PDF erstellen

Alternativ, wenn jede  Zeichnung auf ein eigenes Modell referenzieren soll:
1. Öffne 3D Modell
2. Passe die Maße im 3D Modell an
3. Speichere das 3D Modell als neue Version
4. Öffne die Zeichnung mit Vorlage Bemaßung und eines Vorlagemodells
5. Tausche Vorlagemodell und aktuelle Version
6. Speicher die Zeichnung

Bei Methoden sind durch VBA Programmierung über die API problemlos umsetzbar 

Bei Fragen nochmal melden

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