Kod VBA do zmiany odniesienia podczas otwierania pliku . SLDPRT (Biblioteka SLDPRT)

Poniżej kodu musi pobrać 2 obiekty, które mimo to są dobrze wybrane w solidworks!

Opcja jawna

'Dim swApp As Object (Obiekt Ciemny)
Dim swApp jako SldWorks.SldWorks
'Przyciemnij część jako obiekt
Przyciemnij część jako SldWorks.ModelDoc2

Przyciemnij element jako obiekt
Dim vBody jako wariant
Dim boolstatus As Boolean
Dim longstatus As Long
Przyciemnij długie ostrzeżenia tak długo
Dim FeatureName As Ciąg
Przyciemnij nazwę pliku jako ciąg
Dim fileconfig As String
Dim filedispname jako ciąg
Przyciemnij opcje pliku tak długo
Przyciemnij filtr jako ciąg
Przyciemnij kawałek jako ciąg
Dim swModExt jako SldWorks.ModelDocExtension
Dim swBody jako SldWorks.Body2
Dim sBodySelStr As String
Dim sBodyTypeSelStr As String
Słońce i tak długo
Dim bRet As Boolean
Przyciemnij wynik jako ciąg

Łącznik podrzędny()
    'Ustaw swApp = Application.SldWorks

'Odzyskanie uruchomionej instancji SolidWorks
Ustaw swApp = GetObject(, "SldWorks.Application")

'Umożliwia wyświetlanie aplikacji SolidWorks.
swApp.Visible = Prawda
Jeśli swApp jest niczym, to
Ustaw swApp = CreateObject("SldWorks.Application")
swApp.Visible = Prawda
Zakończ jeżeli:
   
    MsgBox ("Główny wybór pliku!" & vbCrLf & "Główny wybór pliku!")

    Filter = "Pliki Solidworks (*.sldprt; *.sldasm)|*.sldprt;*.sldasm"
    Otwiera plik nadrzędny
    filename = swApp.GetOpenFilename("Wybór pliku nadrzędnego", "", Filtr, fileoptions, fileconfig, filedispname)
   
    Ustaw część = swApp.OpenDoc6(nazwa pliku, 1, 0, "", longstatus, longwarnings)
    Ustaw cechę = Part.FirstFeature
   
    Chociaż nie funkcja jest niczym
        FeatureName = Feature.Name
        Jeśli Feature.GetTypeName2 = "Zapasy", to
            Element = NazwaElementu
        Zakończ jeżeli:
        Ustaw cechę = Feature.GetNextFeature()
    Wend
   
    'Usuwa plik »Treść części«
    boolstatus = Part.Extension.SelectByID2(Element, "BODYFEATURE", 0, 0, 0, Fałsz, 0, Nic, 0)
    Part.EditDelete (Część.EdytujUsuń
   
    MsgBox ("Wybierz część do odjęcia!" & vbCrLf & "Wybierz część do odjęcia!")
   
    Otwiera plik do odjęcia
    filename = swApp.GetOpenFilename("Wybór pliku do odjęcia", "", Filtr, fileoptions, fileconfig, filedispname)
    Ustaw cechę = Part.InsertPart2(nazwa pliku, 15)
          
    vBody = Part.GetBodies2(swSolidBody, True)
    SelectBodies swApp, Część, vBody
               
    'Ustaw cechę = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, Nic, Nic)
    Sun SelMgr jako SelectionMgr
    Ustaw SelMgr = Part.SelectionManager
    Ustaw cechę = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, SelMgr.GetSelectedObject6(1, 1), SelMgr.GetSelectedObject6(1, 2))
   
Koniec subwoofera

Sub SelectBodies(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vBody As Variant)


    Jeśli IsEmpty(vBody), a następnie Wyjdź z Sub
    Ustaw swModExt = swModel.Extension
    Dla i = 0 TB UBound(vBody)
        Ustaw swBody = vBody(i)
        sBodySelStr = swBody.GetSelectionId
        wynik = sBodySelStr
        Jeśli InStr(wynik, ">-<") Następnie
            bRet = swModExt.SelectByID2(wynik, "BRYŁA", 0#, 0#, 0#, Prawda, 2, Nic, 0)
        Inaczej
            bRet = swModExt.SelectByID2(wynik, "SOLIDBODY", 0#, 0#, 0#, Prawda, 1, Nic, 0)
        Zakończ jeżeli:
    Dalej i
       
Koniec subwoofera

Witam

Jak uruchomić makro?

Przejąłem Twoje makro w całości i działa ono bardzo dobrze na moim komputerze.

Pozdrowienia

Uruchamiam go z pól wyboru w formularzach użytkownika, próbowałem też uruchomić go na żywo z edytora VBA, ale nadal ten sam błąd.

Z drugiej strony ten, który wysłałeś, działa doskonale.

Pozdrowienia.

Sprawdź, czy nie masz uruchomionych kilku procesów Solidworks. Nie mogę odtworzyć błędu , który masz na 2 różnych komputerach, więc trudno powiedzieć, skąd może pochodzić.

Witam

Czy to nie jest na "SelectBodies swApp, Part, vBody", że się zawiesza?

Debuguj krok po kroku, aby zobaczyć, co jest nie tak.

Ten komunikat pojawia się, gdy funkcja używa obiektu, który jest równy nic.

1 polubienie

Witaj d.roger, Yves.T !

To wszystko, wszystko działa!!

Błąd wynikał z faktu, że w opcji narzędzia VBA znajdowały się niezaznaczone odniesienia do Solidworks , co w związku z tym powinno powodować problem z komunikacją z oprogramowaniem.

Wybrałem więc wszystkie referencje. Solidworks i ja przyjrzymy się później, aby ustalić, który z nich był winny. (Umieściłem Cię w celach informacyjnych w załącznikach, których brakowało referencji)

Jeszcze raz wielkie podziękowania za trafność wszystkich rad i wsparcia dla rozwiązania tego problemu, a d.roger nadal "majstruje" w ten sposób!! ☺


lyncoa_20171016.gif