VBA-Code zum Ändern der Referenz beim Öffnen einer . SLDPRT

Unterhalb des Codes müssen die 2 Objekte abgerufen werden, die in solidworks dennoch gut ausgewählt sind!

Explizite Option

'Dim swApp Als Objekt
Dim swApp als SldWorks.SldWorks
'Teil als Objekt dimmen
Dimmen des Teils als SldWorks.ModelDoc2

Dimmen von Feature als Objekt
Dim vBody als Variante
Dim boolstatus als boolescher Wert
Dim longstatus As Long
Dim longwarnings So lange
Dim FeatureName als Zeichenfolge
Dim-Dateiname als Zeichenfolge
Dim fileconfig als Zeichenfolge
Dim filedispname als Zeichenfolge
Dateioptionen so lange dimmen
Filter als Zeichenfolge dimmen
Dim-Stück als Schnur
Dim swModExt As SldWorks.ModelDocExtension
Dim swBody As SldWorks.Body2
Dim sBodySelStr As String
Dim sBodyTypeSelStr As String
Sonne i So lang
Dim bRet als boolescher Wert
Ergebnis als Zeichenfolge dimmen

Sub-Combiner()
    'Set swApp = Application.SldWorks

'Stellen Sie die laufende SolidWorks Instanz wieder her
Set swApp = GetObject(, "SldWorks.Application")

'Ermöglicht es Ihnen, die SolidWorks Anwendung anzuzeigen.
swApp.Visible = Wahr
Wenn swApp nichts ist, dann
Set swApp = CreateObject("SldWorks.Application")
swApp.Visible = Wahr
Ende, wenn
   
    MsgBox ("Hauptdateiauswahl!" & vbCrLf & "Hauptdateiauswahl!")

    Filter = "Solidworks Dateien (*.sldprt; *.sldasm)|*.sldprt;*.sldasm"
    Öffnet die übergeordnete Datei
    filename = swApp.GetOpenFilename("Auswählen der übergeordneten Datei", "", Filter, fileoptions, fileconfig, filedispname)
   
    Set Part = swApp.OpenDoc6(Dateiname, 1, 0, "", longstatus, longwarnings)
    Set Feature = Part.FirstFeature
   
    Auch wenn kein Feature nichts ist
        FeatureName = Feature.Name
        Wenn Feature.GetTypeName2 = "Lager" dann
            Stück = FeatureName
        Ende, wenn
        Set Feature = Feature.GetNextFeature()
    Wend
   
    'Löscht die Datei 'Part Body'
    boolstatus = Part.Extension.SelectByID2(Stück, "BODYFEATURE", 0, 0, 0, Falsch, 0, Nichts, 0)
    Part.EditDelete
   
    MsgBox ("Teil zum Subtrahieren auswählen!" & vbCrLf & "Zum Subtrahieren Teil auswählen!")
   
    Öffnet die Datei, die subtrahiert werden soll
    filename = swApp.GetOpenFilename("Auswahl der zu subtrahierenden Datei", "", Filter, fileoptions, fileconfig, filedispname)
    Set Feature = Part.InsertPart2(Dateiname, 15)
          
    vBody = Part.GetBodies2(swSolidBody, True)
    SelectBodies swApp, Teil, vBody
               
    'Set Feature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, Nichts, Nichts)
    Sun SelMgr als AuswahlMgr
    Set SelMgr = Part.SelectionManager
    Set Feature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, SelMgr.GetSelectedObject6(1, 1), SelMgr.GetSelectedObject6(1, 2))
   
Ende Sub

Sub SelectBodies(swApp als SldWorks.SldWorks, swModel als SldWorks.ModelDoc2, vBody als Variante)


    Wenn IsEmpty(vBody), dann Sub beenden
    Legen Sie swModExt = swModel.Extension fest
    Für i = 0 TB UBound(vBody)
        Legen Sie swBody = vBody(i) fest.
        sBodySelStr = swBody.GetSelectionId
        Ergebnis = sBodySelStr
        if InStr(result, ">-<") dann
            bRet = swModExt.SelectByID2(Ergebnis, "SOLIDBODY", 0#, 0#, 0#, Wahr, 2, Nichts, 0)
        Oder
            bRet = swModExt.SelectByID2(Ergebnis, "SOLIDBODY", 0#, 0#, 0#, Wahr, 1, Nichts, 0)
        Ende, wenn
    Weiter i
       
Ende Sub

Hallo

Wie starten Sie Ihr Makro?

Ich habe Ihr Makro in seiner Gesamtheit übernommen und es funktioniert sehr gut auf meinem Computer.

Herzliche Grüße

Ich führe es über Kontrollkästchen in Benutzerformularen aus, ich habe auch versucht, es live über den VBA-Editor auszuführen, aber immer noch der gleiche Fehler.

Auf der anderen Seite wird das, was Sie gesendet haben, perfekt ausgeführt.

Herzliche Grüße.

Überprüfen Sie alle Gefahren, wenn nicht mehrere Solidworks Prozesse ausgeführt werden. Ich kann den Fehler , den Sie auf 2 verschiedenen PCs haben, nicht reproduzieren, daher ist es schwer zu sagen, woher er kommen könnte.

Hallo

Würde es nicht bei "SelectBodies swApp, Part, vBody" abstürzen?

Debuggen Sie Schritt für Schritt, um zu sehen, was falsch ist.

Diese Meldung wird angezeigt, wenn eine Funktion ein Objekt verwendet, das gleich nichts ist.

1 „Gefällt mir“

Hallo d.roger, Yves.T !

Das war's, alles funktioniert!!

Der Fehler kam daher, dass es in der Werkzeugoption der VBA ungeprüfte Solidworks-Referenzen gab, die daher ein Kommunikationsproblem mit der Software verursachen sollten.

Also habe ich alle Refs ausgewählt. Solidworks und ich werden später nachsehen, um festzustellen, welches Spiel schuld war. (Ich habe Ihnen zur Information die fehlenden Refs in Anhänge gesetzt)

Nochmals ein großes Dankeschön für die Relevanz all Ihrer Ratschläge und Unterstützung für die Lösung dieses Problems, und d.roger "bastelt" weiterhin auf diese Weise!! ☺


lyncoa_20171016.gif