Ok, hier is het deel dat ik heb getest, evenals de macro:
HEXA POOL TEST. SLDPRT (567.1 KB)
00-MASSA-OPPERVLAK.swp (36 KB)
Geen probleem van mijn kant, ongeacht de waarde van de coëfficiënt (je moet een punt als komma zetten).
Misschien kunt u de referenties van het macroproject raadplegen:
Anders kan er een subtiliteit zijn aan de kant van de landinstelling van het station en het decimaalteken.
2 likes
Probeer de komma te vervangen door een punt.
2 likes
Welkom @Cyril_f
De macro werkt alleen als ik de eigenschap SURFACE PIECE in F8 maak.
Als het veld niet wordt aangemaakt, gebeurt er niets.
Ik ben op zoek geweest naar hoe ik het veld automatisch kan maken, maar ik zit vast.
Dit is wat ik tevergeefs probeerde te sleutelen:
Optie Expliciete
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim swModelDocExt als ModelDocExtension
Dim swCustProp als CustomPropertyManager
Zon sMass als snaar
Dim sValout als snaar
Dim sVal als snaar
Dim bRet als snaar
Sub hoofd()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(" PC ") 'Als de eigenschap in het tabblad Aanpassen staat, laat dan dit leeg door ' PC ' te vervangen door ' '
bRet = swCustProp.Get6' , False, sValout, sMasse, False, False) 'Het ophalen van de massa-eigenschap, het wijzigen van de naam van de eigenschap om bij uw model te passen
sVal = CStr(CDec(sMass) * 2) 'Converteer tekst naar decimale waarde, vermenigvuldig x RATIO en converteer naar tekstgegevens
'bRet = swCustProp.Set2(" SURFACE PIECE ", sVal) 'Vul de eigenschap SURFACE PIECE in met de waarde geconverteerd naar tekst
bRet = swModel.AddCustomInfo3(" PC ", " SURFACE PIECE ", val)
Einde Sub
Ik heb het geprobeerd met deze opdracht, maar ik denk dat er iets mis is:
bRet = swModel.AddCustomInfo3(" PC ", " SURFACE PIECE ", val)
Heeft u een idee om dit alstublieft te corrigeren?
In plaats van:
'bRet = swCustProp.Set2("OPPERVLAKTE STUK", sVal)
Zet iets als:
bRet = swCustPropMgr.Add3(" SURFACE PIECE ", swCustomInfoType_e.swCustomInfoDate, sVal, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Set is wanneer de eigenschap al bestaat, lijkt mij.
Zie deze link:
https://help.solidworks.com/2020/English/api/sldworksapi/Add_and_Get_Custom_Properties_Example_VB.htm?verRedirect=1
Of completer:
2 likes
Dat klopt.
Als de eigenschap niet bestaat, moet je hem maken, als hij wel bestaat, gebeurt het ook dat SW niet kan schrijven (het is mij overkomen op oude bestanden) en in dit geval moet je de eigenschap verwijderen en opnieuw maken.
2 likes
Ik antwoord zelf, het is opgelost met Add3 waarmee je kunt overschrijven als de eigenschap al bestaat.
Dus eigenlijk:
swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
2 likes
Hallo, bedankt voor je antwoorden.
De macro 00-MASS-SURFACE werkt goed. Weet u echter hoe u slechts 3 cijfers achter de komma kunt hebben voor de oppervlaktewaarde?
00-MASS-SURFACE.swp (45.5 KB)
En ik wil deze macro graag integreren in de 00-MACRO HEXA macro hieronder:
00-MACRO HEXA.swp (63,5 KB)
Ik heb het getest, maar ik krijg deze foutmelding wanneer ik de macro start:
De debug geeft me dit:
Weet jij hoe je dit kunt corrigeren?
Bedankt
Hallo
Dus voor de fout is het waarschijnlijk de variabele swCustProp.Get6 die leeg is, dus de eigenschap bestaat niet of er is een probleem met de variabeleverklaring.
Om te beperken tot 3 decimalen, moet u de functie "Formatteren" gebruiken:
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
2 likes
De declaratie voor swCustProp ontbreekt, door de 3 regels erboven toe te voegen werkt het wel (let op je code heeft nog een goede opschoning nodig (2x Set swModel...)
Hier is de code om op te ruimen:
Dim swModelDocExt As ModelDocExtension
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
2 likes
Ik antwoord mezelf, het missen van de set van de swCustProp variabele, vandaar de fout:
Set swCustProp = swModelDocExt.CustomPropertyManager("POIDS") 'Propriété à changer si ce n'est pas celle-ci
2 likes
Ja, ik bevestig dat er schoongemaakt moet worden.
Het is doe-het-zelf, ik probeer dit allemaal te begrijpen, niet gemakkelijk 
Ik heb opgeruimd en ik heb een nieuwe melding over Dim i:
(tConfig(i)) is het goed voor alle configuraties?
Hallo
Dim i moet elders in de code worden aangegeven.
Er zou de volledige code voor nodig zijn om het te begrijpen.
2 likes
Het probleem is dus de overpositionering van de DIM i als gehele getallen declaratie.
Kortom, aangezien er een lijn Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i)) aan het begin van de macro is, initieert vba de variabele i uit zichzelf.
Zij is derhalve van mening dat er sprake is van een dubbele variabeleaangifte.
Van mijn kant geef ik er de voorkeur aan om de variabeledeclaraties globaal te hebben voor alle Subs in plaats van ze in elke procedure te declareren (hangt sterk af van het gebruik van variabelen en de verschillende procedures/functies in de macro)
1 like
Je hebt ook 2 keer de swApp-aangifte, één keer boven de Sub en één keer helemaal aan het begin van de Sub.
Voordat u een aangifte doet, moet u nagaan of deze niet al bestaat.
En in het idee is het maken van de aangiften helemaal aan het begin van de sub of buiten (voor de sub) naar mijn mening schoner.
Zoiets als dit klinkt mij beter in de oren:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustProp As CustomPropertyManager
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Dim bRet As String
Dim swModelDocExt As ModelDocExtension
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Sub main()
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Default" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
'récupère le document actif dans SW
If Not swModel Is Nothing Then
'''-----------------------------------------------
''' lignes délplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("PC", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("R6029", "", "", True, False, False, True, 256)
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute un propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée edition avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur Poids
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(CDec(sMasse) * 0.0556)
'Création de la propriété SURFACE PIECE avec la valeur sVal
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
End Sub
Met de code-editor is het gemakkelijker om de code te visualiseren dan om een swp-bestand ter informatie bij te voegen.
2 likes
Hallo @Cyril_f @Lynkoa15 en bedankt voor je antwoorden,
Hier ben ik weer over mijn probleem dat ik vandaag opnieuw oppak.
Ik heb mijn code opgeschoond. Het was een puinhoop!
Maar ik eindig met een foutcode 91:
De debug geeft me deze regel:
Hier is mijn code, als je enig idee hebt waar de fout zit:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Sub main()
'''-----------------------------------------------
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
Set swModelDocExt = swModel.Extension
'Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
Set swCustProp = swModelDocExt.CustomPropertyManager("00")
'''-----------------------------------------------
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
''' lignes déplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute une propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée MASSE avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée POIDS avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
'Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
'Préférences SolidWorks
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
'boucle jusqu'a ce qu'il n'y ai plus de fichier ouvert dans SW
Loop While Not swModel Is Nothing
End Sub
Hartelijk dank
Ik antwoord mezelf. Ik zocht en zocht... 
Toen ik mijn macro voor het eerst startte, bleef deze op deze regel staan:
Ik heb het commando BEËINDIGD en in de F8-eigenschappen kon ik zien dat PROFIELEN/massa/GEWICHT en MATERIALEN goed op de hoogte waren. Het ontbrak dus SURFACE PIECE
Ik startte opnieuw op en de macro werkte tot het einde door SURFACE PIECE goed te vullen.
Alsof de macro voor het eerst werd gestart, kon deze de waarde van WEIGHT die net daarvoor is berekend niet ophalen.
Dus ik heb een deel reconstructie toegevoegd tussen MATERIALEN en het herstel van massa-eigendom en het werkt. 
Ik heb mijn macro getest met een enkele configuratiecreatie en de SURFACE PIECE was correct.
Vervolgens heb ik mijn macro getest door de creatie van 3 configuraties te integreren: 00 / PC / R1018.
SURFACE PIECE is goed gemaakt in de 3 configuraties, maar ik krijg maar een goed berekeningsresultaat op één configuratie.
Heb je een idee van het probleem?
Hier is de code:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Sub main()
'''-----------------------------------------------
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
Set swModelDocExt = swModel.Extension
'''-----------------------------------------------
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
''' lignes déplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("PC", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("R1018", "", "", True, False, False, True, 256)
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute une propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée MASSE avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée POIDS avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'on reconstruit la pièces
swModel.ForceRebuild3 False
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
'Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
'Préférences SolidWorks
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
'boucle jusqu'a ce qu'il n'y ai plus de fichier ouvert dans SW
Loop While Not swModel Is Nothing
End Sub
Ik antwoord mezelf nog een keer!
Ik heb de macro gewijzigd door aan het begin alleen configuratie 00 te maken en vervolgens alle eigenschappen in te vullen.
Ten slotte maak ik alle andere configuraties, die de eigenschappen van de oorspronkelijke configuratie overnemen.
JIPPIE!!!
Bedankt voor de hulp. Het is me gelukt om met je advies rond te komen.
1 like