So fügen Sie eine Freigabe mit einem Makro in ein ASM ein

Macro
1

Hallo

Hier verwenden wir Schrauben mit bestimmten Nummern. Diese Schrauben werden entsprechend ihrer Anzahl im Netzwerk gespeichert. Ich versuche, ein Makro zu erstellen, das die Zahl in einem Excel abruft und dann die besagte Schraube in die aktive Baugruppe einfügt. Bisher habe ich es geschafft, die Schraube zu öffnen, aber es ist unmöglich, sie einzuführen, können Sie mir helfen?

 

Vielen Dank

 

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

Hallo

Für die Addition wird ein Boolescher Wert benötigt.

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

Andernfalls, da Addcomponent aus API-Sicht veraltet ist, sehen Sie sich die AddComponent5-Methode an (SW2016 ist möglich, dass sie in Ihrer Version nicht vorhanden ist)

3

anscheinend habe ich die

swApp.ActivateDoc2

 

Das funktioniert auch nicht, ist das auch eine andere Syntax?

 

Vielen Dank für Ihre Hilfe Cyril.f

4

Sie benötigen ein Objekt vom Typ SldWorks.ModelDoc2 und erstellen dann einen Satz.

Siehe in der Hilfe: http://help.solidworks.com/2016/English/api/sldworksapi/Open_Part_from_Assembly_Example_VB.htm

5

Wow, ich bin verloren. Ich habe es versucht, aber es gibt Inkompatibilitäten

Ich gebe an, dass ich dies tatsächlich von Excel aus mache

 

6

So viel wie möglich vereinfachen:

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

Es funktioniert, aber ich musste das "SldWorks.ModelDoc2" durch "object" ersetzen

Glauben Sie, dass ich das Gleiche tun könnte, aber von dem, was in der Presse gespeichert ist? Wenn ich eine Zahl kopiere, wird sie mit dem Makro geöffnet (falls es natürlich existiert)? Wo bekomme ich den Wert der Zwischenablage?

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

Guten Abend

Verwenden Sie die Zwischenablage nicht zum Exportieren von Daten. BESONDERS mit Office.

Es ist möglich, mehrere Daten in die Zwischenablage zu legen.

Sie müssen den Wert der Zelle durchgehen, um den Wert zu kopieren. Auf diese Weise gibt es keine unerwarteten Wertprobleme.

10

@Yves.T: nicht falsch, ich gebe nur einen Link zur Methode an, um auf die Zwischenablage zuzugreifen. Es liegt an jedem Einzelnen, sich seinen Bedürfnissen anzupassen.