Edytuj stronę i zapisz część automatycznie za pomocą VBA

yvespilloy · 14 Listopad 2017 09:31

Witam

Posiadam makro, które podmienia wszystkie składowe złożenia modelu wszystkimi złożeniami wybranymi przez użytkownika za pomocą pliku Excel, co pozwala nam bardzo szybko zbudować maszynę złożoną ze standardowych elementów.

Dla jednego z tych elementów (części) zmieni się tylko jeden wymiar w zależności od kilku opcji wybranych przez użytkownika.

Mogłem stworzyć część solidworks specyficzną dla każdej możliwości, ale ponieważ ta część będzie specyficzna dla każdej maszyny, wolałem wtedy stworzyć ogólny model tej części:

Zaimportuj go do mojego zespołu modelu maszyny
Otwórz tę część ogólną
Edytuj tę ocenę
Zapisz część i jej rysunek pod nową nazwą (rysunek ogólny jest już gotowy)
i zamknij tę część, aby powrócić do montażu w budowie.

Ze wszystkich kroków wymienionych powyżej, mogę zaimportować tylko moją część ogólną (nazwa części TEST. SLDPRT), zaznaczamy go, otwieramy, a następnie wybieramy dany wymiar, który nosi nazwę "DIAM", dla pozostałych kroków pomyślałem, że skorzystam z nagrania makra do zmiany wartości wybranego wymiaru, zapisania części pod nową nazwą (a także jej rysunku poprzez otwarcie go przed zapisaniem pliku części), Niestety na nagraniu nie ma nic do tych działań...

Kopiuję/wklejam kod, który posiadam, aby wybrać moją część, otwieram go i wybieram wymiar, którego wartość chcę zmienić:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("TEST-1@ASSY TEST", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.OpenCompFile

' Open the part TEST.SLDPRT 
Set Part = swApp.OpenDoc6("PATCH\TEST.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc

' Select dimension "DIAM"
boolstatus = Part.Extension.SelectByID2("DIAM@Sketch1@TEST.SLDPRT", "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)

End Sub

Więc moje pytanie jest raczej oczywiste, czy ktoś ma pomysł na:

Zmienianie wartości wybranego wymiaru
Otwieranie rysunku wybranej części
Zapisywanie części pod nową nazwą
Zapisywanie rysunku pod nową nazwą
Zamknij wszystko, aby wrócić do zestawu

Próbowałem już szukać, manipulować zaznaczeniami, ale muszę przyznać, że bardzo łatwo gubię się w solidworks VBA w porównaniu z Excel VBA i dlatego mam trudności z manipulowaniem zaznaczeniami itp.

Z góry dziękuję za pomoc

P.S: przepraszam za brak akcentów, używam angielskiej klawiatury...

Yves

d_roger · 14 Listopad 2017 11:06

Witam

Odbywa się to w pośpiechu, więc bez zwykłych kontroli, ale powinno być w stanie ci pomóc:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("TEST-1@ASSY TEST", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.OpenCompFile

' Open the part TEST.SLDPRT
Set Part = swApp.OpenDoc6("PATCH\TEST.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc

' Select dimension "DIAM"
boolstatut = Part.Extension.SelectByID2("DIAM@Sketch1@TEST.SLDPRT", "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)

' On change la valeur de la cote
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim dimValue As Variant
Dim newDimValue As String
newDimValue = "50"
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = Part.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject5(1)
Set swDim = swDispDim.GetDimension
dimValue = swDim.SetValue3(newDimValue, swThisConfiguration, "")
Part.ForceRebuild

'on récupére l'emplacement du fichier
Dim stPath As String
stPath = Part.GetPathName
'on récupére le nombre de caractére jusqu'au . de l'extension
lgFichier = InStrRev(stPath, ".", -1, vbTextCompare) - 1
'on récupére le chemin sans l'extention
If lgFichier > 0 Then
      stPath = Left(stPath, lgFichier)
End If

' On ouvre le plan TEST.SLDDRW
Set Part = swApp.OpenDoc6(stPath & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Part.ForceRebuild
Dim newNameDRW As String
newNameDRW = stPath & "-2.SLDDRW"
boolstatut = Part.SaveAs3(newNameDRW, 0, 0)
' On ferme le plan
swApp.CloseDoc (newNameDRW)

' On active la pièce
Set Part = swApp.ActiveDoc
Dim newNamePRT As String
newNamePRT = stPath & "-2.SLDPRT"
boolstatut = Part.SaveAs3(newNamePRT, 0, 0)
' On ferme la pièce
swApp.CloseDoc (newNamePRT)

End Sub

Pozdrowienia

yvespilloy · 14 Listopad 2017 11:18

Dziękuję bardzo d.roger, wydaje się, że działa idealnie!

d_roger · 14 Listopad 2017 11:59

Witam

Nie ma za co, jeśli Ci się spodoba, wszystko, co musisz zrobić, to zweryfikować odpowiedź.

Pamiętaj, aby przeprowadzić pewne kontrole bezpieczeństwa, aby uniknąć awarii (na przykład, jeśli jest to plan, który jest załadowany, a następnie ..., jeśli jest to część, która jest załadowana, to ..., itp.)

Pozdrowienia

yvespilloy · 16 Listopad 2017 14:01

Witam

Do tego pytania szybko wrócę.

Utrzymuję, że jego kod działa dokładnie tak, jak wyjaśniłem.

Z drugiej strony mam po tym jeszcze jeden problem: odniesieniem do rysunku pozostaje oryginalna część, a nie nowa.

Sposób, jaki mogę wymyślić, aby przezwyciężyć ten problem, to poprzedzenie w tej kolejności:

- otwarte 3D

- otwarte 2D

- aktywacja 3D

- modyfikacja 3D (wartość wymiaru)

- zarejestrować 3D pod nową nazwą

- Zamknij 3D

- wróć do 2D (logicznie rzecz biorąc, powinien to zrobić sam, ponieważ 2D było ostatnim otwartym dokumentem)

- zapisz 2D pod nową nazwą

- Zamknij okno 2D

- normalnie automatycznie wracamy do 3D montażu

W tej kolejności, ponieważ dokument części jest zapisywany pod nową nazwą, gdy jego rysunek jest otwarty, odniesienie do rysunku jest automatycznie nowym dokumentem części.

wszystko, co muszę teraz zrobić, to wiedzieć, jak nawigować między różnymi otwartymi dokumentami, a tym samym aktywować dokument (krok pogrubiony) po otwarciu 2D.

Z góry dziękuję

Yves

d_roger · 17 Listopad 2017 14:58

Witam

Moim zdaniem to nie wystarczy, ponieważ w palecie widoków nowego planu mogą znajdować się ślady Twojej oryginalnej części. Wolałbym zrobić coś takiego:

- otwarte 3D

- modyfikacja 3D (wartość wymiaru)

- zarejestrować 3D pod nową nazwą

- otwarte 2D

- zamiana modelu 3D w rzutach 2D

- zmiana palety widoków rzutu 2D

- zapisz 2D pod nową nazwą

- Zamknij okno 2D

- Zamknij 3D

- normalnie automatycznie wracamy do 3D montażu

W przypadku kroków pogrubionych można użyć następującego kodu:

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSelectionMgr As SldWorks.SelectionMgr
Dim swDrawingComponent As SldWorks.DrawingComponent
Dim views(0) As Object
Dim swView As SldWorks.View
Dim instances(0) As Object
Dim status As Boolean

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawingDoc = swModel
    status = swModel.ActivateView("Vue de mise en plan1")

    Set swModelDocExt = swModel.Extension
    status = swModelDocExt.SelectByID2("Vue de mise en plan1", "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
    Set swSelectionMgr = swModel.SelectionManager
    Set swView = swSelectionMgr.GetSelectedObject6(1, -1)
    Set views(0) = swView

    status = swModelDocExt.SelectByID2("TEST@Vue de mise en plan1", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    Set swDrawingComponent = swSelectionMgr.GetSelectedObject6(1, -1)
    Set instances(0) = swDrawingComponent.Component
    status = swDrawingDoc.ReplaceViewModel(newNamePRT, (views), (instances))
    
    swDrawingDoc.GenerateViewPaletteViews (newNamePRT)
End Sub

Pozdrowienia

d_roger · 17 Listopad 2017 16:38

Jeśli chcesz poruszać się po otwartych oknach oprogramowania, możesz użyć następującego kodu jako przewodnika:

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swFrame As SldWorks.Frame
Dim swModelWindow As SldWorks.ModelWindow
Dim modelWindows As Variant
Dim obj As Variant
Dim errors As Long
Dim warnings As Long
Dim HWnd As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swFrame = swApp.Frame
    modelWindows = swFrame.modelWindows
    For Each obj In modelWindows
        Set swModelWindow = obj
        Set swModelDoc = swModelWindow.ModelDoc
        Set swModelDoc = Nothing
        swFrame.ShowModelWindow swModelWindow
        HWnd = swModelWindow.HWnd
        Debug.Print ("  Model window handle: " & HWnd)
        Debug.Print ("  Model title as it seen in the model's window's title bar: " & swModelWindow.Title)
        If swModelWindow.Title = "Pièce12.SLDPRT" Then
            Exit For
        End If
    Next obj
End Sub

Pozdrowienia