Jak wstawić udział do asm za pomocą makra

yoanelaroche · 4 Kwiecień 2017 08:16

Witam

Tutaj używamy o określonych numerach. te są przechowywane zgodnie z ich numerem w sieci. Próbuję zrobić makro, które pobiera liczbę w Excelu, a następnie wstawia wspomnianą do aktywnego zespołu. Do tej pory udaje mi się otworzyć, ale nie da się jej włożyć, czy możesz mi pomóc?

Dziękuję

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

Cyril_f · 4 Kwiecień 2017 10:09

Witam

Do dodawania potrzebna jest wartość logiczna.

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

W przeciwnym razie, ponieważ Addcomponent jest przestarzały z punktu widzenia API, spójrz na metodę AddComponent5 (SW2016 możliwe, że nie istnieje w Twojej wersji)

yoanelaroche · 4 Kwiecień 2017 11:58

widocznie mam

swApp.ActivateDoc2

To też nie działa, czy to też inna składnia?

dziękuję za pomoc Cyril.f

Cyril_f · 4 Kwiecień 2017 12:02

Potrzebny jest obiekt typu SldWorks.ModelDoc2, a następnie utwórz zestaw.

Zobacz w Pomocy: http://help.solidworks.com/2016/English/api/sldworksapi/Open_Part_from_Assembly_Example_VB.htm

yoanelaroche · 4 Kwiecień 2017 12:23

Wow, jestem zagubiony. Próbowałem, ale są niezgodności

Zaznaczam, że robię to z Excela w rzeczywistości

Cyril_f · 4 Kwiecień 2017 13:47

Uproszczenie tak bardzo, jak to możliwe:

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

yoanelaroche · 4 Kwiecień 2017 15:21

to działa, ale musiałem zamienić "SldWorks.ModelDoc2" na "object"

Czy myślisz, że mógłbym zrobić to samo, ale z tego, co jest zapisane w gazecie prasowej? Na przykład, jeśli skopiuję liczbę, otworzy ją z makrem (jeśli oczywiście istnieje)? Gdzie mogę uzyskać wartość schowka?

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

Cyril_f · 4 Kwiecień 2017 15:48

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

yvest · 4 Kwiecień 2017 18:07

Dobry wieczór

Nie używaj schowka do eksportowania danych. ZWŁASZCZA z pakietem Office.

Możliwe jest umieszczenie kilku danych w schowku.

Musisz przejść przez wartość komórki, aby skopiować wartość. W ten sposób nie ma nieoczekiwanych problemów z wartością.

Cyril_f · 5 Kwiecień 2017 05:32

@Yves.T: nie źle, po prostu wskazuję link do metody dostępu do schowka. To od każdej osoby zależy, czy dostosuje się do swoich potrzeb.