Comment insérer une part dans un asm avec une macro

Macro
1

Bonjour,

  Voilà nous utilisons des vis avec des numéros spécifiques. Ces vis sont stockées selon leur numéro sur le réseau. J'essaie de faire une macro qui récupére le numéro dans un excel pour ensuite insérer la dite vis dans l'assemblage actif. Jusqu'ici j'arrive à faire ouvrir la vis mais impossible d'insérer, pouvez vous m'aider ?

 

Merci

 

Sub ouvrirdanssolidworks()
'
'Option Explicit



Dim swApp As Object, swModel As Object
Dim myError As Long, myWarning As Long
Dim swAssembly As Object

Set swApp = CreateObject("SldWorks.Application")

If swApp.GetDocumentCount = 0 Then
MsgBox "Aucun fichier ouvert"
Set swApp = Nothing
End If
Set swModel = swApp.ActiveDoc
'If swModel.GetType <> swDocASSEMBLY Then
'MsgBox "Le document actif n'est pas un assemblage"
'End
'End If

a = ActiveCell.Value
b = "C:\EPDM_VAULT1\1 000 00x-Fournitures\"

c = 1
d = Val(Right(ActiveCell.Value, 3))
e = Left(ActiveCell.Value, 6)
If Val(Right(ActiveCell.Value, 3)) > 499 Then c = 2

AssemblyTitle = swModel.GetTitle
Set swAssembly = swModel


If c = 1 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "000-" & e & "499\" & a & ".sldprt"
If c = 2 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "500-" & e & "999\" & a & ".sldprt"

Set swModel = swApp.OpenDoc6(fichier, 1, 0, "", myError, myWarning)

If c = 1 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "000-" & e & "499\" & a & ".prt"
If c = 2 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "500-" & e & "999\" & a & ".prt"

Set swModel = swApp.OpenDoc6(fichier, 1, 0, "", myError, myWarning)

'insérer

swApp.ActivateDoc2 AssemblyTitle, False, longstatus
'Set Part = swApp.ActiveDoc

'Set swComponent = swAssembly.AddComponent(AssemblyTitle, "", 0, 0, 0)

End Sub

 

2

Bonjour,

Pour l'ajout c'est un booléen qu'il faut.

boolstatus = Part.AddComponent(Toto, 0 0, 0)

Sinon, vu que Addcomponent est obsolète d'un point de vue API, regarder à AddComponent5 Method (SW2016 possible que ça n'existe pas sur votre version)

3

apparemment j'ai le

swApp.ActivateDoc2

 

qui ne fonctionne pas non plus, c'est une autre syntaxe aussi ?

 

merci pour ton aide Cyril.f

4

Il faut un objet de type SldWorks.ModelDoc2 puis faire un set.

Voir dans l'aide: http://help.solidworks.com/2016/English/api/sldworksapi/Open_Part_from_Assembly_Example_VB.htm

5

oulala je suis perdu. j'ai essayé mais y'a des incompatibilités

je précise que je fais ca depuis Excel en fait

 

6

En simplifiant un maximum:

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim myError As Long
Dim myWarning As Long
Dim swAssembly As SldWorks.ModelDoc2
Dim fichier As String
Dim swcomponent As SldWorks.Component2

Sub ouvrirdanssolidworks()

Set swApp = CreateObject("SldWorks.Application")

If swApp.GetDocumentCount = 0 Then
MsgBox "Aucun fichier ouvert"
Set swApp = Nothing
End If
Set swModel = swApp.ActiveDoc


AssemblyTitle = swModel.GetTitle

fichier = "C:\xxx\xxx.sldprt"

Set swModel = swApp.OpenDoc6(fichier, 1, 0, "", myError, myWarning)

Set swModel = swApp.ActivateDoc3(AssemblyTitle, True, swUserDecision, myError)
  Set swAssembly = swModel
  

    ' Add the part to the assembly document
     Set swcomponent = swAssembly.AddComponent5(fichier, swAddComponentConfigOptions_CurrentSelectedConfig, "", False, "", 0, 0, 0)

End Sub

 

7

ca fonctionne mais j'ai du remplacer les "SldWorks.ModelDoc2" par des "object"

tu crois que je pourrais faire la même chose mais depuis ce qui est stocké dans le presse paper ? Genre si je copie un numéro ca me l'ouvre avec la macro (s'il existe bien sûr) ? Où je peux aller chercher la valeur du presse papier ?

Sub ouvrirdanssolidworks()

Dim swApp As Object  'ici
Dim swModel As Object  'ici SldWorks.ModelDoc2
Dim myError As Long
Dim myWarning As Long
Dim swAssembly As Object  'ici SldWorks.ModelDoc2
Dim fichier As String
Dim swcomponent As Object  'ici SldWorks.Component2

Set swApp = CreateObject("SldWorks.Application")

If swApp.GetDocumentCount = 0 Then
MsgBox "Aucun fichier ouvert"
Set swApp = Nothing
End If
Set swModel = swApp.ActiveDoc


AssemblyTitle = swModel.GetTitle

a = ActiveCell.Value
b = "C:\EPDM_VAULT1\1 000 00x-Fournitures\"

c = 1
d = Val(Right(ActiveCell.Value, 3))
e = Left(ActiveCell.Value, 6)
If Val(Right(ActiveCell.Value, 3)) > 499 Then c = 2


If c = 1 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "000-" & e & "499\" & a & ".sldprt"
If c = 2 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "500-" & e & "999\" & a & ".sldprt"

Set swModel = swApp.OpenDoc6(fichier, 1, 0, "", myError, myWarning)

'If c = 1 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "000-" & e & "499\" & a & ".prt"
'If c = 2 Then fichier = "C:\EPDM_VAULT1\1 000 00x-Fournitures\" & e & "500-" & e & "999\" & a & ".prt"
'Set swModel = swApp.OpenDoc6(fichier, 1, 0, "", myError, myWarning)

extensionTitle = swApp.ActiveDoc.GetTitle
Set swModel = swApp.ActivateDoc3(AssemblyTitle, True, swUserDecision, myError)
Set swAssembly = swModel
  
' Add the part to the assembly document
Set swcomponent = swAssembly.AddComponent5(extensionTitle, swAddComponentConfigOptions_CurrentSelectedConfig, "", False, "", 0, 0, 0)

End Sub

 

8

https://www.developpez.net/forums/d582239/logiciels/microsoft-office/excel/macros-vba-excel/copie-contenu-d-variable-presse-papier/

9

Bonsoir,

Il ne faut pas utiliser le presse papier pour exporter des données. SURTOUT avec Office.

Il est possible de placer plusieurs données dans le presse papier.

Il faut passer par la valeur de la cellule pour en copier la valeur. En faisant ça, pas de problème de valeur inatendues.

10

@Yves.T: pas faux, j'indique juste un lien vers la méthode pour accéder au presse papier. A chacun d'adapter en fonction de son besoin.