Solidworks stap vba eigenschappen bewerken

Bob_2000 · 4 november 2022 om 08:09

Hallo mensen
wanneer ik een *.step-assembly importeer en opsla als een Solidworks-assembly met alle onderdelen gescheiden in een map, kunnen de eigenschappen niet worden bewerkt

Ik heb een macro gemaakt om de eigenschappen te kopiëren, de eigenschappen te verwijderen, de eigenschappen te plakken
Alles werkt, tenzij het type eigenschap een formule-achtige vergelijking is (zoals materie bijvoorbeeld)

hier is mijn code, die ik zou uitvoeren via Mycadtool-integratie om alle assemblage- en onderdeelbestanden te herhalen

Is er iets dat ik zou hebben gemist in de macro om de formule te kopiëren en niet het resultaat van de formule

in grijs de niet-wijzigbare eigenschappen
in het wit degene die ik heb toegevoegd
Als ik voor de test (ik heb geen bestand met dit type: formule in de stappen, ik doe het voor alle gevallen) een formule toevoeg, wordt het resultaat gekopieerd, maar niet de formule

C-HC schroeven (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 om 10:19

U krijgt de geëvalueerde waarde van de eigenschap, u zou de /Expression-waarde van de eigenschap moeten krijgen, zie dit onderwerp:

Het gaat om de volgende eigenschappen:
Debug.Print indent & "Value/Text Expression: " & prpVal
Debug.Print indent & "Geëvalueerde waarde: " & prpResVal

Lynkoa15 · 4 november 2022 om 10:30

Hallo
Zoals sbadenis zegt, met Get6, krijg je de waarde van de uitdrukking terug

Bob_2000 · 4 november 2022 om 11:15

Ik weet niet hoe ik de macro moet schrijven
Ik heb dit geprobeerd, maar het geeft alleen een balg; Tabel verwacht op de lijn
"custPropType = swCustProp.GetType2(Veldnaam(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 om 12:51

Veldnaam is de naam van de eigenschap om in te voeren (niet uitvoer) gewoon implementeren met de vorige code, je hebt de naam met getall, gebruik get6 om de expressie te krijgen

Bob_2000 · 4 november 2022 om 13:43

Ik heb veel moeite met macro's

Ik begrijp onder andere niet waarom (Len(custPropType)) niet de juiste waarde retourneert
Voor een type: getal geeft het 4 terug, terwijl het resultaat 3 is, d.w.z. 1 in lengte???

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 om 13:55

Bijgevoegd is een screenshot,
Ik gebruikte get5 (versie 2016)
Verwijder getall, het heeft niet veel zin, gebruik in plaats daarvan, getnames

Lynkoa15 · 4 november 2022 om 14:04

Voor het aantal
Heeft u " nummer " correct gekozen in de eigenschappentabel, voor mij is de geretourneerde waarde correct
Capture2

Bob_2000 · 4 november 2022 om 14:10

Ja, ik zet nummer, maar len moet het aantal tekens tellen, maar het nummer eigenschap retourneert het nummer 3, het vindt 4 cijfers ???

Lynkoa15 · 4 november 2022 om 14:24

Ik zag net deze functie, het is noch 4 noch 3, maar een 1, omdat het strings verwerkt, dus voor een relevant resultaat moet je string gebruiken (of converteren naar) string

Bob_2000 · 4 november 2022 om 14:25

Als je een idee hebt, begrijp ik niet hoe ik het moet doen

Lynkoa15 · 4 november 2022 om 14:28

Ik heb gewoon gebruikt
Dim custproptype als string
Aangezien vba gebruik maakt van een stand-alone conversiesysteem,
Er is ook de cstr(integer) functie
Len(cstr(custproptype) )
Ik adviseer de tweede methode, als de eigenschap ooit ergens anders wordt gebruikt, om de consistentie van de typen beter te behouden

Bob_2000 · 4 november 2022 om 14:41

Geweldig, alles werkt dankzij de hulp van jullie allemaal

Hier is de macro
Te wijzigen volgens de opmerkingen voor degenen die dat wensen
We zullen merken dat het type 'vergelijking' is omgezet in 'tekst', maar het werkt nog steeds

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 om 15:43