bonjour à tous,
J ai besoin d'aide pour créer une macro, mes connaissances étant quasi inexistante dans ce domaine je suis en galère des la première étape.
Généralement j'arrive à me débrouiller tant bien que mal en copiant des morceaux venant de droite et de gauche, mais la je ne trouve rien qui ressemble en tout cas pour le début.
La macro a pour but de copier certaines propriétés de personnalisé issu d'une pièce vers un assemblage.
1 - Condition : etre dans un assemblage
2 - Définir la piece sélectionné dans l'arbre de construction comme source des propriétés.
3 - Lire la propriété "REFERENCE" de la pièce sélectionné
4 - Afficher la valeur de la propriété et avoir le choix de continuer ou d'annuler
5 - Ecrire la propriété "REFERENCE" dans l'assemblage en cour
6 - fin
Pour le moment je suis bloqué à l'étape n°2 car je ne sais pas comment peut s'appeler la fonction à utiliser.
si quelqu'un peut m'aiguiller ,
d'avance merci.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set SwModel = swApp.ActiveDoc 'on récupére le document actif
' Vérifie qu'il s'agit d'un assemblage
If SwModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 "Ne Fonctionne qu'avec un ASSEMBLAGE!", swMbWarning, swMbOk
Exit Sub
End If
End Sub
Bonjour,
Pour les points 2 et 3, tu peux t'aider du code suivant :
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Debug.Print ValOut
Debug.Print ResolvedValOut
End If
End Sub
Cordialement,
1 « J'aime »
Re-bonjour,
Pour le point 4, tu peux t'aider du code suivant :
Dim Rep As Integer
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
' ici le traitement si réponse positive
' ...
Else
' ici le traitement si réponse négative
' ...
End If
Cordialement,
1 « J'aime »
Re-re-bonjour,
Donc voici un exemple pour les points 2 - 3 - 4 - 5 et 6 :
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Else
MsgBox "Aucune sélection."
Exit Sub
End If
Dim Rep As Integer
Dim result As String
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Delete2("REFERENCE")
Retval = swCustPropMgr.Add2("REFERENCE", swCustomInfoText, ResolvedValOut)
result = "Modification effectuée."
Else
result = "Aucune modification effectuée."
End If
MsgBox result
End Sub
Cordialement,
2 « J'aime »
Re-re-.......
Petite information complémentaire, il faut que le composant sélectionné soit en mode résolu sinon cela ne marche pas, il te faudra alors mettre ce composant en mode résolu avant la ligne "Set swModelDocExt = swSelModel.Extension" qui est dans le "If Not swSelComp Is Nothing Then".
Cordialement,
1 « J'aime »
Bonjour @d.roger
merci pour ton aide je regarde ca cette semaine,
@d.roger,
Je n'ai pas eu beaucoup de temps aujourd'hui, mais je vais avoir d'autres questions :-)
Bonjour a tous,
je reviens à la charge avec mes questions,
Y à t'il une solution pour récupérer plusieurs propriétés personnalisé sans multiplier le nombre de variables " Retval, ValOut ... " par autant ?
Mon autre question est de savoir ci il possible d'appliquer les propriétés copier à toutes les configurations de l'assemblage quelques soit le nom des configurations.
d'avance merci,
Bonne soirée.
Bonjour,
" Y à t'il une solution pour récupérer plusieurs propriétés personnalisé sans multiplier le nombre de variables " Retval, ValOut ... " par autant ? " : Oui, il faut faire une boucle sur la lecture des propriétés personnalisés et ajouter celles qui t'intéressent dans un tableau, voir ICI.
" Mon autre question est de savoir ci il possible d'appliquer les propriétés copier à toutes les configurations de l'assemblage quelques soit le nom des configurations. " : Oui, il faut aussi faire une boucle sur les configurations de l'assemblage dans la laquelle tu mets ton code de création des propriétés, voir ICI pour la fonction permettant de lister les configurations.
Cordialement,
1 « J'aime »
Bonjour @ d.roger,
merci pour les infos pour le site "développez.com" qui va bien m'aider j'en suis sur.
cordialement.
bonjour,
La période d'accalmie au travail s'étant vite passé, je n'ai pas eu le temps de continuer la macro, je me la derniere réponse de @D.Roger comme solution car les liens proposé sont très intéressant.
J'espere pouvoir finir la macro prochainement,