Hoe een aandeel in een asm met een macro in te voegen

Macro
1

Hallo

Hier gebruiken we schroeven met specifieke nummers. Deze schroeven worden op basis van hun nummer op het netwerk opgeslagen. Ik probeer een macro te maken die het nummer in een excel ophaalt en vervolgens de genoemde schroef in de actieve assemblage plaatst. Tot nu toe lukt het me om de schroef open te krijgen, maar onmogelijk om in te brengen, kun je me helpen?

 

Bedankt

 

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

Voor de toevoeging is een Booleaanse nodig.

boolstatus = Deel.Component(Foo, 0, 0, 0)

Anders, aangezien Addcomponent verouderd is vanuit een API-oogpunt, kijk naar AddComponent5 Method (SW2016 mogelijk dat het niet bestaat op uw versie)

3

blijkbaar heb ik de

swApp.ActivateDoc2

 

Dat werkt ook niet, is dat ook een andere syntaxis?

 

bedankt voor je hulp Cyril.f

4

Je hebt een object van het type SldWorks.ModelDoc2 nodig en maakt dan een set.

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

5

Wauw, ik ben verdwaald. Ik heb het geprobeerd, maar er zijn onverenigbaarheden

Ik geef aan dat ik dit in feite vanuit Excel doe

 

6

Zoveel mogelijk vereenvoudigen:

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

het werkt, maar ik moest de "SldWorks.ModelDoc2" vervangen door "object"

Denk je dat ik hetzelfde zou kunnen doen, maar dan van wat er in het perspapier is opgeslagen? Als ik bijvoorbeeld een nummer kopieer, wordt het geopend met de macro (als het bestaat natuurlijk)? Waar kan ik de waarde van het klembord krijgen?

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

Goedenavond

Gebruik het klembord niet om gegevens te exporteren. VOORAL met Office.

Het is mogelijk om meerdere gegevens op het klembord te plaatsen.

U moet de waarde van de cel doorlopen om de waarde te kopiëren. Door dit te doen, geen onverwachte waardeproblemen.

10

@Yves.T: niet verkeerd, ik geef alleen een link aan naar de methode om toegang te krijgen tot het klembord. Het is aan elke persoon om zich aan te passen aan zijn behoeften.