Aktualizacja kaset z makrami na wielu arkuszach

Witam wszystkich,

Zaprojektowałem makro umożliwiające aktualizację mojego wkładu za pomocą formularza użytkownika, który znajduje się tutaj.

Pobiera istniejące informacje w kartridżu i umożliwia jego aktualizację bez konieczności wykonywania wszystkiego ręcznie. Działa bardzo dobrze, ale jeśli jest tylko jedna płyta.

Mój problem polega na duplikowaniu tych informacji na ewentualne 2, 3 itd... deska, jeśli występuje. Wiedząc, że nagle notatki mapy bazowej, które są aktualizowane na tablicy 1, nie będą miały tej samej nazwy na dodanych płytach.

Jeśli ktoś ma pomysł, jak to zrobić, jestem jak najbardziej za. :wink:

Dziękuję

Witam

Czy jest to pragnienie, aby nie mieć tych samych nazw z jednej strony na drugą?
Jeśli tak nie jest, najprostszym sposobem jest powiązanie właściwości z tymi notatkami, a zatem aktualizujemy tylko właściwości i rozwijają się one na innych folio

Witam

Nie, w ogóle, to tylko obserwacja. Dodanie nowej tablicy w programie do PE powoduje, że nowe notatki nie mają tej samej nazwy. nazywa się to "Obiekt détail1137@Fond planu1", ale na nowej tabliczce jest to "Obiekt détail1137@Fond planu3", nazwa arkusza ulega zmianie. i nie mogłem zarządzać tymi ustawieniami.

Skuteczne powiązanie z nieruchomością byłoby w rzeczywistości prostsze.

Czy wiesz, jak to zrobić?

Przede wszystkim musisz utworzyć szablony dla mapy bazowej i rysunku.
Po wykonaniu tej czynności notatki na mapie bazowej, które powinny być powiązane z samym rysunkiem, powinny być napisane w następujący sposób: §PRP:xxxx (xxxx to nazwa właściwości)
Posiadanie dokładnie tych samych planów tła i notatek we wszystkich formatach stron (na przykład od A4 do A0) znacznie upraszcza makro.
Myślę, że można to było również zrobić w edytorze formularzy właściwości, a nie za pomocą makra.

1 polubienie

Ok dziękuję.
szablon mapy bazowej/MEP Na razie zrobiłem tylko jeden, ale później zrobię inne (że zadziała :wink: ).

Przechodzę tutaj, aby " nazwać " nuty?
image

Pomyślałem o edytorze formularzy, aby uznać go za mniej " intuicyjny "

Tak, musisz przejść przez "Edytuj tekst w oknie" lub po prostu kliknąć dwukrotnie notatkę, aby ją edytować (jak podstawową notatkę).

Ok dziękuję. Zrobione.

image

Jak mogę odwołać się do tych właściwości w moim kodzie?

Ponownie, musisz pobawić się niestandardowymi właściwościami, zobacz przykład pod tym linkiem Pobierz niestandardowe właściwości dla przykładu konfiguracji (VBA) - 2022 - Pomoc SOLIDWORKS API

1 polubienie

Ok, dzięki za pomoc, zagłębię się w to.

Witam

Utknąłem. :frowning: W przykładzie są to

Set cusPropMgr = config.CustomPropertyManager

linia, która działa tylko wtedy, gdy uruchomisz kod z udziałem ... Jestem na MEP, więc nie można wykonać pakietu kodów.

Co robić?

Witam
To ta sama zasada.
Musisz mieć te dwie deklaracje:

    Set swModelDocExt = swModel.Extension
    Set swCustProp = swModelDocExt.CustomPropertyManager("")

2 polubienia

Ok, dziękuję, chyba czegoś mi brakuje...

Opcja jawna

Dim swApp jako SldWorks.SldWorks
Przyciemnij swModel jako SldWorks.DrawingDoc
Przyciemnij konfigurację jako SldWorks.Configuration
Dim swCustProp As SldWorks.CustomPropertyManager
Dim lRetVal tak długo
Dim vPropNames jako wariant
Dim vPropTypes jako wariant
Dim vPropValues jako wariant
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim linkToProp As Boolean
Dim rozwiązany jako wariant
Przyciemnij linkProp jako wariant
Dim nNbrProps tak długo
Słońce j tak długo
Dim custPropType As Long
Dim bRet As Boolean

Sub mainTest()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set config = swModel.GetActiveConfiguration

' Ustaw cusPropMgr = config. CustomPropertyManager

Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Witam

Na rysunkach nie ma konfiguracji.
Zasadniczo kod byłby taki (wstępnie przeżułem zadanie, umieszczając pętlę przetwarzania w celu zastosowania zmian)

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swModelDocExt   As ModelDocExtension
Dim swCustProp      As CustomPropertyManager
Dim swDraw          As SldWorks.DrawingDoc
Dim bRet            As Boolean
Dim iAddProp        As Integer
Dim lretVal         As Long
Dim sProp(11)       As String
Sub Tableprop()
sProp(0) = "REV1": sProp(1) = "DATE1": sProp(2) = "NOM1": sProp(3) = "MODIF1"
sProp(4) = "REV2": sProp(5) = "DATE2": sProp(6) = "NOM2": sProp(7) = "MODIF2"
sProp(8) = "REV3": sProp(9) = "DATE3": sProp(10) = "NOM3": sProp(11) = "MODIF3"

End Sub
Sub mainTest()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Set2(sProp(i), "yyy")
    End If
Next i
End Sub

Musisz dodać przetwarzanie, aby pobrać dane z formularza w zmiennej tabeli i obsłużyć wszystkie możliwe przypadki (puste pola, zaznaczenie pola już zaktualizowanego o tę samą wartość...)
"yyy" musiałoby zatem zostać zastąpione przez tablicę zmiennych, która pobiera wyniki.

2 polubienia

Dziękuję @Cyril_f za cenną pomoc, po odrobinie poszukiwań i uporu udało mi się uruchomić kompletny kod.

Poniżej umieszczam część kodu, która aktualizuje MEP i pobiera istniejące informacje w MEP.

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swModelDocExt   As ModelDocExtension
Dim swCustProp      As CustomPropertyManager
Dim swDraw          As SldWorks.DrawingDoc
Dim bRet            As Boolean
Dim iAddProp        As Integer
Dim lretVal         As Long
Dim sProp(11)       As String
Dim ValeursUsF(11) As String

Sub Tableprop()

sProp(0) = "REV1": sProp(1) = "DATE1": sProp(2) = "NOM1": sProp(3) = "MODIF1"
sProp(4) = "REV2": sProp(5) = "DATE2": sProp(6) = "NOM2": sProp(7) = "MODIF2"
sProp(8) = "REV3": sProp(9) = "DATE3": sProp(10) = "NOM3": sProp(11) = "MODIF3"

End Sub

Sub MajMEP()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop
Call TableValeurTableau

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Set2(sProp(i), ValeursUsF(i))
    End If
Next i

End Sub

Sub TableValeurTableau()

'Chaque champs du userform
ValeursUsF(0) = TabRev.Bx0.Value: ValeursUsF(1) = TabRev.Bx1.Value: ValeursUsF(2) = TabRev.Bx2.Value: ValeursUsF(3) = TabRev.Bx3.Value
ValeursUsF(4) = TabRev.Bx4.Value: ValeursUsF(5) = TabRev.Bx5.Value: ValeursUsF(6) = TabRev.Bx6.Value: ValeursUsF(7) = TabRev.Bx7.Value
ValeursUsF(8) = TabRev.Bx8.Value: ValeursUsF(9) = TabRev.Bx9.Value: ValeursUsF(10) = TabRev.Bx10.Value: ValeursUsF(11) = TabRev.Bx11.Value

End Sub

Sub RecupValMEP()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop
Call TableValeurTableau

Dim Val As String
Dim resolved As Boolean
Dim Title As String

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Get5(sProp(i), False, ValeursUsF(i), Title, resolved)
    End If
    
Next i

For i = 0 To UBound(ValeursUsF)

TabRev("Bx" & i).Value = ValeursUsF(i)

Next

End Sub
2 polubienia

Fajna wspólna praca.
I dziękujemy, że myślisz o dołączeniu do ukończonego Makro.
Pozostaje tylko zweryfikować najlepszą odpowiedź, zamknąć ten temat. :grinning:
image

2 polubienia

Witam

Nie martw się o pomoc.
Z drugiej strony uważam, że kod powinien być uproszczony lub przynajmniej zoptymalizowany.
Zainicjowanie zmiennej swApp w dwóch różnych procedurach może spowodować wygenerowanie błędu.
Jeśli między wyewidencjonowaniem wartości a aktualizacją nie ma danych wyjściowych z procedury głównej, cały ten kod można wprowadzić do procedury głównej:

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop
Call TableValeurTableau

Mam też mały problem ze zrozumieniem, do czego służy ta część kodu:

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Get5(sProp(i), False, ValeursUsF(i), Title, resolved)
    End If
    
Next i

Naprawdę nie rozumiem, co próbujesz zrobić w tym fragmencie kodu, ponieważ nie jest on później używany.

Witam

Rzeczywiście, jest dość optymalny. Postaram się to zrobić. Dziękuję

Druga część pozwala mi pobrać wartości właściwości, w przypadku już wypełnionego planu, aby wyświetlić je w moim formularzu użytkownika z następującą linią kodu.

For i = 0 To UBound(ValeursUsF)

TabRev("Bx" & i).Value = ValeursUsF(i)

Next

Może nie jest to najlepsza metoda, ale ma tę zaletę, że działa. :wink: