Eigenschaften der Solidworks-Stufe vba bearbeiten

Bob_2000 · 4. November 2022 um 08:09

Hallo Welt
Wenn ich eine *.step-Baugruppe als Solidworks-Baugruppe importiere und speichere, wobei alle ihre Teile in einem Ordner getrennt sind, können die Eigenschaften nicht bearbeitet werden

Ich habe ein Makro erstellt, um die Eigenschaften zu kopieren, die Eigenschaften zu löschen und die Eigenschaften einzufügen
Alles funktioniert, es sei denn, der Typ der Eigenschaft ist eine formelartige Gleichung (wie z. B. Materie)

Hier ist mein Code, den ich über Mycadtool Integration ausführen würde, um alle Baugruppen- und Teiledateien zu schleifen

Gibt es etwas, das ich im Makro übersehen hätte, um die Formel und nicht das Ergebnis der Formel zu kopieren?

in grau die nicht veränderbaren Eigenschaften
in weiß das, was ich hinzugefügt habe
Wenn ich für den Test (ich habe keine Datei mit diesem Typ: Formel in den Schritten, ich mache es für alle Fälle) eine Formel hinzufüge, wird das Ergebnis kopiert, aber nicht die Formel

C-HC Schrauben (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. November 2022 um 10:19

Wenn Sie den ausgewerteten Wert der Eigenschaft abrufen, sollten Sie den /Expression-Wert der Eigenschaft abrufen, siehe dieses Thema:

Die betroffenen Immobilien:
Debug.Print indent & "Wert/Textausdruck: " & prpVal
Debug.Print indent & "Ausgewerteter Wert: " & prpResVal

Lynkoa15 · 4. November 2022 um 10:30

Hallo
Wie sbadenis sagt, erhalten Sie mit Get6 den Wert des Ausdrucks zurück

Bob_2000 · 4. November 2022 um 11:15

Ich weiß nicht, wie ich das Makro schreiben soll
Ich habe das versucht, aber es gibt nur ein Brüllen; Erwartete Tabelle auf der Linie
"custPropType = swCustProp.GetType2(Feldname(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. November 2022 um 12:51

Fieldname ist der Name der Eigenschaft, die eingegeben werden soll (nicht ausgegeben), implementieren Sie einfach mit dem vorherigen Code, Sie haben den Namen mit getall erhalten, verwenden Sie get6, um den Ausdruck abzurufen

Bob_2000 · 4. November 2022 um 13:43

Ich habe große Probleme mit Makros

Ich verstehe unter anderem nicht, warum (Len(custPropType)) nicht den richtigen Wert zurückgibt
Für einen Typ: number wird 4 zurückgegeben, während das Ergebnis 3 ist, d.h. 1 lang???

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. November 2022 um 13:55

Anbei ein Screenshot,
Ich habe get5 (Version 2016) verwendet
Löschen Sie getall, es nützt nicht viel, verwenden Sie stattdessen, getnames

Lynkoa15 · 4. November 2022 um 14:04

Für die Anzahl
Haben Sie in der Eigenschaftstabelle " Zahl " richtig gewählt, für mich ist der zurückgegebene Wert korrekt
Capture2

Bob_2000 · 4. November 2022 um 14:10

Ja, ich habe Zahl gesetzt, aber len muss die Anzahl der Zeichen zählen, aber die number-Eigenschaft gibt die Zahl 3 zurück, sie findet 4 Ziffern ???

Lynkoa15 · 4. November 2022 um 14:24

Ich habe gerade diese Funktion gesehen, sie ist weder 4 noch 3, sondern eine 1, da sie Zeichenketten verarbeitet, also müssen Sie für ein relevantes Ergebnis eine Zeichenkette verwenden (oder in sie umwandeln)

Bob_2000 · 4. November 2022 um 14:25

Wenn du eine Idee hast, verstehe ich nicht, wie man das macht

Lynkoa15 · 4. November 2022 um 14:28

Ich habe einfach
Dim custproptype as string
Da VBA ein eigenständiges Konvertierungssystem verwendet,
Es gibt auch die Funktion cstr(integer)
Len(cstr(custproptype) )
Ich empfehle die zweite Methode, falls die Eigenschaft jemals an anderer Stelle verwendet wird, die Konsistenz der Typen besser zu bewahren

Bob_2000 · 4. November 2022 um 14:41

Großartig, alles funktioniert dank der Hilfe von euch allen

Hier ist das Makro
gemäß den Kommentaren für diejenigen zu ändern, die dies wünschen
Wir werden feststellen, dass der Typ 'Gleichung' in 'Text' umgewandelt wird, aber es funktioniert immer noch

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. November 2022 um 15:43