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.
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
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.
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.
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
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.
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
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.
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.