---

Guten Tag zusammen,

ich möchte gerne in einer vorhanden Skizze alle bestehenden Beziehungen und Verknüpfungen löschen.

Grund: Ich möchte Schweißkonstruktionsvorlagen erstellen, die vom Grundaufbau einen sehr geringen speicherbedarf besitzen um Ladezeiten der endlichen Datei zu minimieren.

Mir ist bewusst das es bei einem Einzelelement nicht viel aus macht aber on der Masse macht sich das bemerkbar.

Habt Ihr eine Idee.

Vielen Dank

Gruß Peter

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

---

In der Skizze gibt es eine Funktion (ICON)
„Skizzenbeziehungen anzeigen“
Dort kann man mit einem Klick alle Beziehungen löschen.

------------------
Andreas Westphal
SOLIDWORKS zertifiziert

Ing.-Büro Westphal

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

---

Hi,

Check out existing macro

"Delete All Constraints in Selected Sketch Example (VBA)"

------------------
elmar

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

---

Schönen guten Tag zusammen,

bisher her habe ich noch kein Makro gefunden zu diesem Thema.

Gibt oder hat zufällig jemand ein Makro was alle Skizzenbeziehung löscht und danach direkt fixiert und das über alle Skizzen in einem Bauteil macht?!?!?

Wäre äußerst dankbar. Leider habe ich selber nicht soviel Ahnung vom Makro schreiben, denke aber für jemanden der sich damit auskennt ist das bestimmt kein Problem ;-)

Grüße Locke

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

---

Hallo Locke,

ich habe dir da mal was zusammengeschuster, kannst es ja mal testen. Hier könnte man wahrscheinlich noch einiges schöner gestallten  .

Grundlage waren die Beispiele "Traverse Assembly and Hide All Sketches Example (VBA)" und "Delete All Constraints in Selected Sketch Example (VBA)" + zusätzlich die SketchAddConstraints (IModelDoc2) Methode für das Fixieren.

Code:

---

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
   
    TraverseModelFeatures swApp, swModel

End Sub

Sub TraverseModelFeatures(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)
    Dim swFeat As SldWorks.Feature

    Set swFeat = swModel.FirstFeature
    TraverseFeatureFeatures swApp, swModel, swFeat
End Sub

Sub TraverseFeatureFeatures(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature)
    Dim swSubFeat As SldWorks.Feature
    Dim swSubSubFeat As SldWorks.Feature
    Dim swSubSubSubFeat As SldWorks.Feature
   
    Dim swSketch As SldWorks.Sketch
    Dim vSketchSeg As Variant
    Dim swSketchSeg As SldWorks.SketchSegment
    Dim vSketchPt As Variant
    Dim swSketchPt As SldWorks.SketchPoint
   
    Dim swSelData As SldWorks.SelectData

    Dim i As Long
    Dim bRet As Boolean

    While Not swFeat Is Nothing
        If swFeat.GetTypeName = "ProfileFeature" Then

            Set swSketch = swFeat.GetSpecificFeature2
           
            swModel.EditSketch
            vSketchSeg = swSketch.GetSketchSegments
            For i = 0 To UBound(vSketchSeg)
                Set swSketchSeg = vSketchSeg(i)
                bRet = swSketchSeg.Select4(False, swSelData): Debug.Assert bRet
                swModel.SketchConstraintsDelAll
                swModel.SketchAddConstraints "sgFIXED"
            Next i
            vSketchPt = swSketch.GetSketchPoints2
            For i = 0 To UBound(vSketchPt)
                Set swSketchPt = vSketchPt(i)
                bRet = swSketchPt.Select4(False, swSelData): Debug.Assert bRet
                swModel.SketchConstraintsDelAll
                swModel.SketchAddConstraints "sgFIXED"
            Next i
           
            swModel.InsertSketch2 True

        End If
       
        Set swSubFeat = swFeat.GetFirstSubFeature
        While Not swSubFeat Is Nothing
            If swSubFeat.GetTypeName = "ProfileFeature" Then

                Set swSketch = swSubFeat.GetSpecificFeature2
               
                swModel.EditSketch
                vSketchSeg = swSketch.GetSketchSegments
                For i = 0 To UBound(vSketchSeg)
                    Set swSketchSeg = vSketchSeg(i)
                    bRet = swSketchSeg.Select4(False, swSelData): Debug.Assert bRet
                    swModel.SketchConstraintsDelAll
                    swModel.SketchAddConstraints "sgFIXED"
                Next i
                vSketchPt = swSketch.GetSketchPoints2
                For i = 0 To UBound(vSketchPt)
                    Set swSketchPt = vSketchPt(i)
                    bRet = swSketchPt.Select4(False, swSelData): Debug.Assert bRet
                    swModel.SketchConstraintsDelAll
                    swModel.SketchAddConstraints "sgFIXED"
                Next i
               
                swModel.InsertSketch2 True

            End If
            Set swSubSubFeat = swSubFeat.GetFirstSubFeature
            While Not swSubSubFeat Is Nothing
                If swSubSubFeat.GetTypeName = "ProfileFeature" Then

                    Set swSketch = swSubSubFeat.GetSpecificFeature2
                   
                    swModel.EditSketch
                    vSketchSeg = swSketch.GetSketchSegments
                    For i = 0 To UBound(vSketchSeg)
                        Set swSketchSeg = vSketchSeg(i)
                        bRet = swSketchSeg.Select4(False, swSelData): Debug.Assert bRet
                        swModel.SketchConstraintsDelAll
                        swModel.SketchAddConstraints "sgFIXED"
                    Next i
                    vSketchPt = swSketch.GetSketchPoints2
                    For i = 0 To UBound(vSketchPt)
                        Set swSketchPt = vSketchPt(i)
                        bRet = swSketchPt.Select4(False, swSelData): Debug.Assert bRet
                        swModel.SketchConstraintsDelAll
                        swModel.SketchAddConstraints "sgFIXED"
                    Next i
                   
                    swModel.InsertSketch2 True

                End If
                Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()
            Wend
            Set swSubFeat = swSubFeat.GetNextSubFeature()
        Wend
        Set swFeat = swFeat.GetNextFeature
    Wend
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

---

Supi das passt, das hilft mir sehr weiter. Vielen Vielen Danke Bernd

     

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