[VBA]Selection dans l'arbre de conception

ybourbon · Mai 12, 2014, 7:14

Bonjour tout le monde!

Après recherches, et fonction d'enregistrement de macro, j'ai réussi à faire le remplacement d'un composant via macro! =)

C'est cool, ça fonctionne, et on peut changer un peu n'importe quoi par n'importe quoi d'autre (faut savoir ce qu'on fait sur l'assemblage en gros)

C'est bien beau donc, mais... Je n'ai été capable que de faire un "GetSelectedObjectsComponent" =(

Donc les allez-retours entre solidworks et excel pour continuer (si jamais il y a plusieurs remplacements à faire) c'est dommage.

Ma question serait donc: "Y aurait il un moyen en vba de selectioner un objet dans l'arbre de conception?"

Comme on le fait pour selectioner un fichier dans un dossier par exemple, un variable "filename" qu'on met dans le code comme "open(filename.sldprt) ^^

voila, encore une fois je viens vous embetez pardonnez moi

Amicalement,

Yoann

jfaradon · Mai 12, 2014, 7:43

Option Explicit

' ******************************************************************************

' C:\Users\jfaradon\AppData\Local\Temp\swx8716\Macro1.swb - macro recorded on 02/19/14 by jfaradon

' ******************************************************************************

Dim swApp As SldWorks.SldWorks

Voici un exemple de macro qui remplace un composant par un autre par selection (il faut donner le nom)

Dim swDoc As SldWorks.ModelDoc2

Dim swAss As SldWorks.AssemblyDoc

Dim stOldFileName As String, stNewFileName As String

Dim bStatus As Boolean

Sub main()

Set swApp = Application.SldWorks

Set swDoc = swApp.ActiveDoc

If swDoc Is Nothing Then Exit Sub

If swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY Then Exit Sub

Set swAss = swDoc

stOldFileName = swApp.GetCurrentMacroPathFolder & "\370-TreeManager\370-Bruleur.SLDPRT"

stNewFileName = swApp.GetCurrentMacroPathFolder & "\370-TreeManager\370-Bruleur - Copie.SLDPRT"

swDoc.Extension.SelectByID2 "370-Bruleur-1@370-Chalumeau", "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

bStatus = swAss.ReplaceComponents(stNewFileName, "", True, True)

swDoc.Extension.SelectByID2 "370-Bruleur - Copie-1@370-Chalumeau", "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

bStatus = swAss.ReplaceComponents(stOldFileName, "", True, True)

End Sub

ybourbon · Mai 12, 2014, 8:22

Bonjour à toi jfaradon =)

Si j'ai bien compris la macro, cela donnerait quelque chose du genre pour que l'utilisateur choisisse la pièce dans l'arbre et celle qui la remplacera:

Dim swDoc As SldWorks.ModelDoc2

Dim swAss As SldWorks.AssemblyDoc

Dim stNewFileName As String

Dim bStatus As Boolean

Dim piece as string

Dim assem as string

Sub main()

Set swApp = Application.SldWorks

Set swDoc = swApp.ActiveDoc

piece= InPutBox("Nom de la pièce à changer")

assem =InPutBox("Nom de l'assemblage ouvert")

Chemin= InPutBox("Chemin de la pièce de remplacement")

Piecebis=InPutBox("Nom Pièce Remplacement")

If swDoc Is Nothing Then Exit Sub

If swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY Then Exit Sub

Set swAss = swDoc

stNewFileName = Chemin & Piecebis & ".SLDPRT"

swDoc.Extension.SelectByID2 Piece & "@" & assem, "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

bStatus = swAss.ReplaceComponents(stNewFileName, "", True, True)

End Sub

PS: oui, je dois avouer que la deuxieme partie je n'ai pas tout compris ^^'

jfaradon · Mai 12, 2014, 11:58

Oui c'est cela ...

et effectivement je n'ai pas nettoyé la fin du code, les dernieres lignes ne servent a rien ...

en fait l'API ReplaceComponents remplace le composant selectionné par le fichier spécifé

ybourbon · Mai 12, 2014, 1:40

C'est étrange, cela ne fait rien, j'ai tenter juste la selection également avec un getpathname à la fin voir s'il selectionnait bien la pièce, et ça me sort l'assemblage dans le msgbox...

Comme si la variable swDoc était restée sur la valeur swApp.activeDoc

ybourbon · Mai 15, 2014, 9:56

Bonjour à tous!

toujours dans mes recherches!

j'ai tenter la fonction .getbyname , qui a fonctionner mais le replacecomponents ne prenait pas effet

j'ai tenter de modifier l'exemple de l'aide solidworks également mais en vain =(

Fonctionnement macro:

"selectionner pièce dans l'arbre de construction

donner chemin + nom de la pièce de rechange
Remplacer la pièce de l'arbre par la pièce de rechange"

La macro que j'ai présentement ne m'indique aucune erreur. mais....ne fait rien non plus :fou:

Sub main()

chemin = InputBox("Chemin de la pièce de remplacement")

piecebis = InputBox("Nom Pièce Remplacement")
stnewfilename = chemin & piecebis & ".SLDPRT"

Set swApp = CreateObject("SldWorks.Application")
Set swComp = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc

Set swAssy = swModel
bstatus = swComp.Extension.SelectByID2("00-XXXXX-0-Came-1@swAssy", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

MsgBox (swComp.GetPathName)

bstatus = swAssy.ReplaceComponents("C:\PDM\11 SIMULATION\01 Etuyeuse continue\Introduction produit\00-XXXXX-0-Came retour plane.SLDPRT", "02", False, True)

MsgBox (swComp.GetPathName)

swAssy.ForceRebuild

End Sub