Cze wszystkim
Potrzebuję pomocy w stworzeniu makra, ponieważ moja wiedza w tej dziedzinie jest prawie żadna, zmagam się od pierwszego kroku.
Zazwyczaj udaje mi się to najlepiej jak potrafię, kopiując kawałki z prawej i lewej strony, ale tutaj nie mogę znaleźć niczego, co by tak wyglądało przynajmniej na początku.
Celem makra jest skopiowanie pewnych właściwości niestandardowych z części do zespołu.
1 - Warunek: być w zgromadzeniu
2 - Zdefiniuj wybrany element w drzewie konstrukcyjnym jako źródło właściwości.
3 - Odczytaj właściwość "REFERENCE" wybranej części
4 - Wyświetl wartość właściwości i miej wybór, czy chcesz kontynuować, czy anulować
5 - Wpisz właściwość "REFERENCE" w bieżącym zestawie
6 - koniec
Na razie utknąłem w kroku 2, ponieważ nie wiem, jak można nazwać funkcję, której należy użyć.
jeśli ktoś może wskazać mi właściwy kierunek,
Z góry dziękuję.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set SwModel = swApp.ActiveDoc 'on récupére le document actif
' Vérifie qu'il s'agit d'un assemblage
If SwModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 "Ne Fonctionne qu'avec un ASSEMBLAGE!", swMbWarning, swMbOk
Exit Sub
End If
End Sub
Witam
Dla punktów 2 i 3 możesz użyć następującego kodu:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Debug.Print ValOut
Debug.Print ResolvedValOut
End If
End Sub
Pozdrowienia
1 polubienie
Witam ponownie,
Dla punktu 4 możesz użyć następującego kodu:
Dim Rep As Integer
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
' ici le traitement si réponse positive
' ...
Else
' ici le traitement si réponse négative
' ...
End If
Pozdrowienia
1 polubienie
Witam ponownie,
Oto więc przykład dla punktów 2 - 3 - 4 - 5 i 6:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Else
MsgBox "Aucune sélection."
Exit Sub
End If
Dim Rep As Integer
Dim result As String
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Delete2("REFERENCE")
Retval = swCustPropMgr.Add2("REFERENCE", swCustomInfoText, ResolvedValOut)
result = "Modification effectuée."
Else
result = "Aucune modification effectuée."
End If
MsgBox result
End Sub
Pozdrowienia
2 polubienia
Ponowne ponowne -.......
Trochę dodatkowych informacji, wybrany komponent musi być w trybie rozwiązanym, w przeciwnym razie nie zadziała, będziesz musiał przełączyć ten komponent w tryb rozwiązany przed wierszem "Set swModelDocExt = swSelModel.Extension", który znajduje się w "Jeśli nie swSelComp Is Nothing Then".
Pozdrowienia
1 polubienie
Witaj @d.roger
dziękuję za pomoc, patrzę na to w tym tygodniu,
@d. Zrozumiałem,
Nie miałam dziś zbyt wiele czasu, ale będę miała więcej pytań :-)
Witam wszystkich,
Wracam z moimi pytaniami,
Czy istnieje rozwiązanie, aby pobrać kilka niestandardowych właściwości bez mnożenia liczby zmiennych "Retval, ValOut ... — Aż tyle?
Moje inne pytanie dotyczy tego, czy możliwe jest zastosowanie właściwości kopiowania do wszystkich konfiguracji zestawu, niezależnie od nazwy konfiguracji.
Z góry dziękujemy,
Dobranoc.
Witam
"Czy istnieje rozwiązanie, aby pobrać kilka niestandardowych właściwości bez mnożenia liczby zmiennych " Retval, ValOut ... — Aż tyle? ": Tak, musisz zapętlić się w odczytywaniu niestandardowych właściwości i dodać te, które Cię interesują w tablicy, zobacz TUTAJ.
" Moje drugie pytanie dotyczy tego, czy możliwe jest zastosowanie właściwości kopiowania do wszystkich konfiguracji zespołu, niezależnie od nazwy konfiguracji. ": Tak, musisz również zrobić pętlę na konfiguracjach zestawu, w którym umieszczasz swój kod, aby utworzyć właściwości, zobacz TUTAJ , aby wyświetlić funkcję wyświetlającą konfiguracje.
Pozdrowienia
1 polubienie
Witam @ d.roger,
Dziękuję za informacje na stronie "développez.com", które na pewno mi dobrze pomogą.
Pozdrowienia.
Witam
Przerwa w pracy szybko minęła, nie miałem czasu na kontynuowanie makro, ostatnią odpowiedź dostałem od @D.Roger jako rozwiązanie, ponieważ proponowane linki są bardzo ciekawe.
Mam nadzieję, że wkrótce uda mi się skończyć makro,