Właściwości edycji kroku VBA w kroku SolidWorks

Bob_2000 · 4 Listopad 2022 08:09

Cześć ludzie
gdy importuję i zapisuję złożenie *.step jako złożenie Solidworks, gdy wszystkie jego części są oddzielone w folderze, właściwości nie są edytowalne

Utworzyłem makro do kopiowania właściwości, usuwania właściwości, wklejania właściwości
Wszystko działa, chyba że typ właściwości jest równaniem typu formuła (jak na przykład materia)

oto mój kod, który uruchomiłbym za pomocą integracji z Mycadtool, aby zapętlić wszystkie pliki zespołów i części

Czy jest coś, czego bym przegapił w makrze, aby skopiować formułę, a nie wynik formuły

w kolorze szarym właściwości niemodyfikowalne
w kolorze białym ten, który dodałem
Jeśli dodam do testu (nie mam pliku z tym typem: formuła w krokach, robię to dla wszystkich przypadków) formułę, jej wynik jest kopiowany, ale nie formuła

C-HC (4)_Vis C-HC-M3-10.SLDPRT (137.4 KB)

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part As Object

Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim linkProp As Variant

Dim i As String
Dim j As Integer
Dim Ligne As Integer
Dim custPropType As Long
Dim lRetVal As Long
Dim retval As Long
Dim Nb_espaces As Integer
Sub Step_proprietes()

'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprimme les propriétés
'03-Ajouter les propriétés
'https://help.solidworks.com/2023/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm?verRedirect=1

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

If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub


'01-Liste les propriétés et les copie
Ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & Ligne
lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)


Dim TABLEAU() As String
ReDim TABLEAU(1 To Ligne, 1 To 3) As String


Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
 
For j = 0 To Ligne - 1
    custPropType = swCustProp.GetType2(vPropNames(j))
    If j + 1 < 10 Then i = "0" & j + 1
    Debug.Print i & " | " & vPropNames(j) & Space(19 - (Len(vPropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & vPropValues(j)
    TABLEAU(j + 1, 1) = vPropNames(j)
    TABLEAU(j + 1, 2) = custPropType
    TABLEAU(j + 1, 3) = vPropValues(j)
Next j


'02-Supprimme les propriétés
For j = 1 To Ligne
swCustProp.Delete TABLEAU(j, 1)
Next j


'03-Ajouter les propriétés
'Problème avec les équations seul le résultat est copié pas la formule
'swCustomInfoDate    64
'swCustomInfoDouble   5
'swCustomInfoNumber   3
'swCustomInfoText    30
'swCustomInfoUnknown  0
'swCustomInfoYesOrNo 11


For j = 1 To Ligne
retval = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j

'Supprime le tableau
Erase TABLEAU
End Sub

sbadenis · 4 Listopad 2022 10:19

Otrzymasz obliczoną wartość właściwości, powinieneś uzyskać wartość /Expression właściwości, zobacz ten temat:

Nieruchomości, których dotyczy wniosek:
Wcięcie Debug.Print & "Wartość/Wyrażenie tekstowe: " & prpVal
Debug.Print wcięcie & "Obliczona wartość: " & prpResVal

Lynkoa15 · 4 Listopad 2022 10:30

Witam
Jak mówi sbadenis, dzięki Get6 odzyskasz wartość wyrażenia

Bob_2000 · 4 Listopad 2022 11:15

Nie wiem jak napisać makro
Próbowałem tego, ale daje tylko miech; Oczekiwano stołu na linii
"custPropType = swCustProp.GetType2(NazwaPola(j))"

Dim FieldName As String
Dim UseCached As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim WasResolved As Boolean
Dim LinkToProperty As Boolean
Dim value As Long

'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés
'https://help.solidworks.com/2023/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm?verRedirect=1

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

If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub


'01-Liste les propriétés et les copie
Ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & Ligne
'lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
'''value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)
value = swCustProp.Get6(FieldName, UseCached, ValOut, ResolvedValOut, WasResolved, LinkToProperty)

Dim TABLEAU() As String
ReDim TABLEAU(1 To Ligne, 1 To 3) As String


Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
 
For j = 0 To Ligne - 1
    'custPropType = swCustProp.GetType2(vPropNames(j))
    custPropType = swCustProp.GetType2(FieldName(j))
    If j + 1 < 10 Then i = "0" & j + 1
    'Debug.Print i & " | " & vPropNames(j) & Space(19 - (Len(vPropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & vPropValues(j)
    Debug.Print FieldName(j) & " " & UseCached(j) & " " & ValOut(j) & " " & ResolvedValOut(j) & " " & WasResolved(j) & " " & LinkToProperty
    'TABLEAU(j + 1, 1) = vPropNames(j)
    'TABLEAU(j + 1, 2) = custPropType
    'TABLEAU(j + 1, 3) = vPropValues(j)
    TABLEAU(j + 1, 1) = FieldName(j)
    TABLEAU(j + 1, 2) = vPropTypes(j)
    TABLEAU(j + 1, 3) = ValOut(j)
Next j

Lynkoa15 · 4 Listopad 2022 12:51

Nazwa pola to nazwa właściwości, którą należy wprowadzić (nie wyjście), po prostu zaimplementuj ją poprzednim kodem, masz nazwę za pomocą getall, użyj get6, aby uzyskać wyrażenie

Bob_2000 · 4 Listopad 2022 13:43

Mam wiele problemów z makrami

Nie rozumiem między innymi, dlaczego (Len(custPropType)) nie zwraca poprawnej wartości
Dla typu: liczba zwraca 4, podczas gdy wynik to 3, czyli 1 długości???

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part As Object

Dim i As String
Dim j As Integer
Dim ligne As Integer
Dim custPropType As Long
Dim Nb_espaces As Integer


Dim PropNames As Variant
Dim PropTypes As Variant
Dim PropValues As Variant
Dim resolved As Variant
Dim PropLink As Variant
'Dim FieldName As String
Dim UseCached As Boolean
Dim valout As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim LinkToProperty As Boolean
Dim value As Long
Sub Step_proprietes()

'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés

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

If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub


'01-Liste les propriétés et les copie
ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & ligne
value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)

Dim TABLEAU() As String
ReDim TABLEAU(1 To ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"

For j = 0 To ligne - 1
    custPropType = swCustProp.GetType2(PropNames(j))
    If j + 1 < 10 Then i = "0" & j + 1
    value = swCustProp.Get6(PropNames(j), UseCached, valout, ResolvedValOut, wasResolved, LinkToProperty)
    'Debug.Print vPropNames(j) & " " & custPropType & " " & UseCached & " " & valout & " " & ResolvedValOut & " " & wasResolved & " " & LinkToProperty
    Debug.Print i & " | " & PropNames(j) & Space(19 - (Len(PropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & valout
    Debug.Print Len(PropNames(j)) & " " & (Len(custPropType))
    TABLEAU(j + 1, 1) = PropNames(j)
    TABLEAU(j + 1, 2) = custPropType
    TABLEAU(j + 1, 3) = valout
Next j


'02-Supprime les propriétés
For j = 1 To ligne
swCustProp.Delete TABLEAU(j, 1)
Next j


'03-Ajouter les propriétés
'Le type 'équation' est transformé en 'texte'
'Si len(custPropType) compte n'importe quoi
'swCustomInfoDate    64
'swCustomInfoDouble   5
'swCustomInfoNumber   3
'swCustomInfoText    30
'swCustomInfoUnknown  0
'swCustomInfoYesOrNo 11


For j = 1 To ligne
value = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j

'Supprime le tableau
Erase TABLEAU
End Sub

Lynkoa15 · 4 Listopad 2022 13:55

W załączeniu znajduje się zrzut ekranu,
Użyłem get5 (wersja 2016)
Usuń getall, nie ma z tego większego pożytku, użyj zamiast tego, getnames

Lynkoa15 · 4 Listopad 2022 14:04

Dla liczby
Jeśli poprawnie wybrałeś " number " w tabeli właściwości, dla mnie zwrócona wartość jest poprawna
Capture2

Bob_2000 · 4 Listopad 2022 14:10

tak, stawiam liczbę, ale len musi policzyć liczbę znaków, ale właściwość number zwraca liczbę 3, znajduje 4 cyfry ???

Lynkoa15 · 4 Listopad 2022 14:24

Właśnie zobaczyłem tę funkcję, nie jest to ani 4, ani 3, ale 1, ponieważ przetwarza ciągi, więc aby uzyskać odpowiedni wynik, będziesz musiał użyć (lub przekonwertować na) ciąg

Bob_2000 · 4 Listopad 2022 14:25

Jeśli masz pomysł, nie rozumiem jak to zrobić

Lynkoa15 · 4 Listopad 2022 14:28

Po prostu użyłem
Dim custproptype jako ciąg znaków
Ponieważ VBA używa samodzielnego systemu konwersji,
Istnieje również funkcja cstr(liczba całkowita)
Len(cstr(custproptype) )
Radzę drugą metodę, jeśli kiedykolwiek właściwość jest używana gdzie indziej, lepiej zachowaj spójność typów

Bob_2000 · 4 Listopad 2022 14:41

Świetnie, wszystko działa dzięki pomocy Was wszystkich

Oto makro
do modyfikacji zgodnie z uwagami dla tych, którzy chcą
Zauważymy, że typ "równanie" jest przekształcany w "tekst", ale nadal działa

Option Explicit
Dim swApp           As SldWorks.SldWorks
Dim swModel         As ModelDoc2
Dim swModelDocExt   As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part            As Object

Dim i               As String
Dim j               As Integer
Dim ligne           As Integer
Dim custPropType    As Long
Dim Nb_espaces      As Integer

Dim PropNames       As Variant
Dim PropTypes       As Variant
Dim PropValues      As Variant
Dim resolved        As Variant
Dim PropLink        As Variant
'Dim FieldName      As String
Dim UseCached       As Boolean
Dim valout          As String
Dim ResolvedValOut  As String
Dim wasResolved     As Boolean
Dim LinkToProperty  As Boolean
Dim value           As Long
Sub Step_proprietes()

'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés

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

If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub


'01-Liste les propriétés et les copie
ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & ligne
value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)

Dim TABLEAU() As String
ReDim TABLEAU(1 To ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"

For j = 0 To ligne - 1
    custPropType = swCustProp.GetType2(PropNames(j))
    If j + 1 < 10 Then i = "0" & j + 1
    value = swCustProp.Get6(PropNames(j), UseCached, valout, ResolvedValOut, wasResolved, LinkToProperty)
    'Debug.Print vPropNames(j) & " " & custPropType & " " & UseCached & " " & valout & " " & ResolvedValOut & " " & wasResolved & " " & LinkToProperty
    Debug.Print i & " | " & PropNames(j) & Space(19 - (Len(PropNames(j)))) & " | " & custPropType & Space(4 - (Len(CStr(custPropType)))) & " | " & valout
    TABLEAU(j + 1, 1) = PropNames(j)
    TABLEAU(j + 1, 2) = custPropType
    TABLEAU(j + 1, 3) = valout
Next j


'02-Supprime les propriétés
For j = 1 To ligne
swCustProp.Delete TABLEAU(j, 1)
Next j


'03-Ajouter les propriétés
'Le type 'équation' est transformé en 'texte'
'swCustomInfoDate    64
'swCustomInfoDouble   5
'swCustomInfoNumber   3
'swCustomInfoText    30
'swCustomInfoUnknown  0
'swCustomInfoYesOrNo 11

For j = 1 To ligne
value = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j

'Supprime le tableau
Erase TABLEAU
End Sub

Lynkoa15 · 5 Listopad 2022 15:43