Ok, hier ist der Teil, den ich getestet habe, sowie das Makro:
HEXA-STANGEN-TEST. SLDPRT (567.1 KB)
00-MASSE-OBERFLÄCHE.swp (36 KB)
Kein Problem für mich, unabhängig vom Wert des Koeffizienten (Sie müssen einen Punkt als Komma setzen).
Schauen Sie vielleicht in den Makroprojektreferenzen nach:
Andernfalls kann es zu einer Feinheit auf der Seite des Gebietsschemas der Station und des Dezimaltrennzeichens kommen.
2 „Gefällt mir“
Versuchen Sie, das Komma durch einen Punkt zu ersetzen.
2 „Gefällt mir“
Hallo @Cyril.f
Das Makro funktioniert nur, wenn ich die Eigenschaft SURFACE PIECE in F8 erstelle.
Wenn das Feld nicht erstellt wird, passiert nichts.
Ich habe nach Möglichkeiten gesucht, das Feld automatisch zu erstellen, aber ich komme nicht weiter.
Hier ist, woran ich erfolglos versucht habe herumzubasteln:
Option Explizit
Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt als ModelDocExtension
Dim swCustProp As CustomPropertyManager
Sonne sMasse als Schnur
Dim sValout As String
Dim sVal As String
Dim bRet als Zeichenfolge
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("PC") 'Wenn sich die Eigenschaft auf der Registerkarte "Anpassen" befindet, lassen Sie das Feld leer, indem Sie "PC" durch "" ersetzen
bRet = swCustProp.Get6', False, sValout, sMasse, False, False) 'Abrufen der Masseneigenschaft, Ändern des Namens der Eigenschaft entsprechend Ihrem Modell
sVal = CStr(CDec(sMass) * 2) 'Text in Dezimalwert umwandeln, x VERHÄLTNIS multiplizieren und in Textdaten umwandeln
'bRet = swCustProp.Set2("SURFACE PIECE", sVal) 'Füllen Sie die Eigenschaft SURFACE PIECE mit dem Wert, der in Text umgewandelt wurde
bRet = swModel.AddCustomInfo3("PC", "SURFACE PIECE", wert)
Ende Sub
Ich habe es mit diesem Befehl versucht, aber ich denke, etwas stimmt nicht:
bRet = swModel.AddCustomInfo3("PC", "SURFACE PIECE", wert)
Haben Sie bitte eine Idee, um das zu korrigieren?
Anstatt:
'bRet = swCustProp.Set2("OBERFLÄCHENSTÜCK", sVal)
Geben Sie etwas aus wie:
bRet = swCustPropMgr.Add3(" SURFACE STÜCK ", swCustomInfoType_e.swCustomInfoDate, sVal, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Set ist, wenn die Eigenschaft bereits vorhanden ist, scheint es mir.
Siehe diesen Link:
https://help.solidworks.com/2020/English/api/sldworksapi/Add_and_Get_Custom_Properties_Example_VB.htm?verRedirect=1
Oder noch vollständiger:
2 „Gefällt mir“
Das stimmt.
Wenn die Eigenschaft nicht existiert, müssen Sie sie erstellen, wenn sie existiert, kommt es auch vor, dass SW nicht schreiben kann (das ist mir bei alten Dateien passiert) und in diesem Fall müssen Sie die Eigenschaft löschen und neu erstellen.
2 „Gefällt mir“
Ich antworte mir, es ist mit Add3 behoben, was es Ihnen ermöglicht, zu überschreiben, wenn die Eigenschaft bereits vorhanden ist.
Also im Grunde:
swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
2 „Gefällt mir“
Hallo, danke für Ihre Antworten.
Das Makro 00-MASS-SURFACE funktioniert gut. Wissen Sie jedoch, wie Sie nur 3 Dezimalstellen für den Flächenwert haben können?
00-MASSE-OBERFLÄCHE.swp (45.5 KB)
Und ich möchte dieses Makro in das 00-MACRO HEXA-Makro unten integrieren:
00-MAKRO HEXA.swp (63.5 KB)
Ich habe getestet, aber ich bekomme diesen Fehler, wenn ich das Makro starte:
Das Debuggen gibt mir Folgendes:
Wissen Sie, wie Sie dies korrigieren können?
Vielen Dank
Hallo
Für den Fehler ist es wahrscheinlich die Variable swCustProp.Get6, die leer ist, sodass die Eigenschaft entweder nicht vorhanden ist oder ein Problem mit der Variablendeklaration vorliegt.
Um auf 3 Dezimalstellen zu begrenzen, müssen Sie die Funktion "Format" verwenden:
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
2 „Gefällt mir“
Die Deklaration für swCustProp fehlt, durch Hinzufügen der 3 Zeilen oben funktioniert es (seien Sie vorsichtig, Ihr Code muss noch gut bereinigt werden (2x Set swModel...)
Hier ist der Code zum Aufräumen:
Dim swModelDocExt As ModelDocExtension
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
2 „Gefällt mir“
Ich antworte mir selbst, dass der Satz der Variablen swCustProp fehlt, daher der Fehler:
Set swCustProp = swModelDocExt.CustomPropertyManager("POIDS") 'Propriété à changer si ce n'est pas celle-ci
2 „Gefällt mir“
Ja, ich bestätige, dass eine Reinigung durchgeführt werden muss.
Es ist DIY, ich versuche, das alles zu verstehen, nicht einfach 
Ich habe aufgeräumt und habe eine neue Warnung zu Dim i:
(tConfig(i)) ist es gut für alle Konfigurationen?
Hallo
Dim i muss an anderer Stelle im Code deklariert werden.
Es würde den vollständigen Code benötigen, um ihn zu verstehen.
2 „Gefällt mir“
Das Problem ist also die Überpositionierung von DIM i als Integer-Deklaration.
Da sich die Zeile Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i)) am Anfang des Makros befindet, initiiert vba die Variable i von selbst.
Sie geht daher davon aus, dass eine doppelte Variablendeklaration vorliegt.
Ich für meinen Teil bevorzuge es, die Variablendeklarationen für alle Subs in global zu haben, anstatt sie in jeder Prozedur zu deklarieren (hängt stark von der Verwendung von Variablen und den verschiedenen Prozeduren/Funktionen im Makro ab)
1 „Gefällt mir“
Sie haben auch die swApp-Deklaration 2 Mal, einmal über dem Sub und einmal ganz am Anfang des Sub.
Bevor Sie eine Erklärung abgeben, müssen Sie herausfinden, ob sie nicht bereits vorhanden ist.
Und in der Idee ist es meiner Meinung nach sauberer, die Deklarationen ganz am Anfang des Subs oder außerhalb (vor dem Sub) zu machen.
So etwas klingt für mich besser:
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
Mit dem Code-Editor ist es einfacher, den Code zu visualisieren, als eine SWP-Datei für Informationen anzuhängen.
2 „Gefällt mir“
Hallo @Cyril.f @Lynkoa15 und vielen Dank für Ihre Antworten,
Hier bin ich wieder bei meinem Problem, das ich heute wieder aufgreife.
Ich habe meinen Code etwas bereinigt. Es war ein Chaos!
Aber am Ende habe ich einen Fehlercode 91:
Das Debuggen gibt mir diese Zeile:
Hier ist mein Code, wenn Sie eine Ahnung haben, wo der Fehler liegt:
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
Vielen Dank
antworte ich mir. Ich suchte und suchte... 
Als ich mein Makro zum ersten Mal startete, blieb es bei dieser Zeile:
Ich habe den Befehl END gemacht und in den F8-Eigenschaften konnte ich sehen, dass PROFILES/MASSE/GEWICHT und MATERIALIEN gut informiert waren. Es fehlte daher SURFACE PIECE
Ich habe neu gestartet und das Makro hat bis zum Ende gearbeitet, indem es SURFACE PIECE gut gefüllt hat.
Als ob das Makro zum ersten Mal gestartet wurde, war es nicht in der Lage, den Wert von WEIGHT abzurufen, der kurz zuvor berechnet wurde.
Also habe ich eine Teilrekonstruktion zwischen MATERIALS und Masseneigenschaftswiederherstellung hinzugefügt und es funktioniert. 
Ich habe mein Makro mit einer einzigen Konfigurationserstellung getestet und das SURFACE PIECE war korrekt.
Dann habe ich mein Makro getestet, indem ich die Erstellung von 3 Konfigurationen integriert habe: 00 / PC / R1018.
SURFACE PIECE ist in den 3 Konfigurationen gut erstellt, aber ich bekomme nur bei einer Konfiguration ein gutes Berechnungsergebnis.
Haben Sie eine Vorstellung von dem Problem?
Hier ist der 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
Ich antworte mir wieder!
Ich habe das Makro geändert, indem ich am Anfang nur die Konfiguration 00 erstellt und dann alle Eigenschaften ausgefüllt habe.
Zum Schluss erstelle ich alle anderen Konfigurationen, die die Eigenschaften der Erstkonfiguration übernehmen.
HURRA!!!
Vielen Dank für Ihre Hilfe. Ich habe es geschafft, mit Ihrem Rat auszukommen.
1 „Gefällt mir“