Hi all
I need help to create a macro, my knowledge being almost non-existent in this field I am struggling from the first step.
Usually I manage to manage as best I can by copying pieces from the right and the left, but here I can't find anything that looks like it at least for the beginning.
The purpose of the macro is to copy certain properties of custom from a part to an assembly.
1 - Condition: be in an assembly
2 - Define the selected part in the construction tree as the source of the properties.
3 - Read the "REFERENCE" property of the selected part
4 - Display the value of the property and have the choice to continue or cancel
5 - Write the "REFERENCE" property in the current assembly
6 - end
For the moment I'm stuck at step 2 because I don't know what the function to use can be called.
if someone can point me in the right direction,
Thank you in advance.
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
Hello
For points 2 and 3, you can use the following code:
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
Kind regards
1 Like
Hello again,
For point 4, you can use the following code:
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
Kind regards
1 Like
Hello again,
So here is an example for points 2 - 3 - 4 - 5 and 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
Kind regards
2 Likes
Re-re-.......
A little additional information, the selected component must be in resolved mode otherwise it won't work, you will then have to put this component in resolved mode before the line "Set swModelDocExt = swSelModel.Extension" which is in the "If Not swSelComp Is Nothing Then".
Kind regards
1 Like
Hello @d.roger
thank you for your help I'm looking at it this week,
@d.Roger,
I didn't have much time today, but I'll have more questions :-)
Hello everyone,
I'm back with my questions,
Is there a solution to retrieve several custom properties without multiplying the number of variables "Retval, ValOut ... "By as much?
My other question is to know if it is possible to apply the copy properties to all the configurations of the assembly regardless of the name of the configurations.
Thank you in advance,
Good night.
Hello
" Is there a solution to retrieve several custom properties without multiplying the number of variables " Retval, ValOut ... "By as much? ": Yes, you have to loop on reading custom properties and add the ones you are interested in in an array, see HERE.
" My other question is to know if it is possible to apply the copy properties to all the configurations of the assembly regardless of the name of the configurations. ": Yes, you also have to make a loop on the configurations of the assembly in which you put your code to create properties, see HERE for the function to list the configurations.
Kind regards
1 Like
Hello @ d.roger,
Thank you for the info for the site "développez.com" which will help me well I'm sure.
Kind regards.
Hello
The lull at work having passed quickly, I didn't have time to continue the macro, I got the last answer from @D.Roger as a solution because the proposed links are very interesting.
I hope to be able to finish the macro soon,