How to insert a share into an asm with a macro

Macro
1

Hello

Here we are using screws with specific numbers. These screws are stored according to their number on the network. I try to make a macro that retrieves the number in an excel and then inserts the said screw in the active assembly. So far I manage to get the screw to open but impossible to insert, can you help me?

 

Thank you

 

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

Hello

For the addition, a Boolean is needed.

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

Otherwise, since Addcomponent is obsolete from an API point of view, look at AddComponent5 Method (SW2016 possible that it doesn't exist on your version)

3

apparently I have the

swApp.ActivateDoc2

 

that doesn't work either, is that another syntax too?

 

thank you for your help Cyril.f

4

You need an object of type SldWorks.ModelDoc2 and then make a set.

See in Help: http://help.solidworks.com/2016/English/api/sldworksapi/Open_Part_from_Assembly_Example_VB.htm

5

Wow, I'm lost. I tried but there are incompatibilities

I specify that I do this from Excel in fact

 

6

Simplifying as much as possible:

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

it works but I had to replace the "SldWorks.ModelDoc2" with "object"

Do you think I could do the same thing but from what is stored in the press paper? Like if I copy a number it opens it with the macro (if it exists of course)? Where can I get the value of the clipboard?

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

Good evening

Do not use the clipboard to export data. ESPECIALLY with Office.

It is possible to place several data in the clipboard.

You have to go through the value of the cell to copy the value. By doing this, no unexpected value problems.

10

@Yves.T: not wrong, I just indicate a link to the method to access the clipboard. It is up to each person to adapt according to their needs.