[VBA] Auswählen aus dem Designbaum

Macro
1

Tag zusammen!

 

Nach Recherche und Makro-Aufnahmefunktion habe ich es geschafft, eine Komponente per Makro zu ersetzen! =)

 

Es ist cool, es funktioniert, und Sie können alles durch alles andere ändern (Sie müssen im Grunde wissen, was Sie an der Montage tun)

 

Das ist alles schön und gut, aber... Ich konnte nur eine "GetSelectedObjectsComponent" =(

Das Hin und Her zwischen SolidWorks und Excel ist also eine Schande, um weiterzumachen (falls es jemals mehrere Ersetzungen gibt), eine Schande.

 

Meine Frage wäre also: "Gäbe es in VBA eine Möglichkeit, ein Objekt im Designbaum auszuwählen?"

 

So wie wir es tun, um eine Datei in einem Ordner auszuwählen, zum Beispiel eine Variable "Dateiname", die wir in den Code einfügen, wie "open(filename.sldprt)^^

 

Da hast du es, ich komme wieder, um dich zu belästigen, verzeih mir

 

Freundlich

 

Yoann

2

Option Explizit

 

' ******************************************************************************

' C:\Users\jfaradon\AppData\Local\Temp\swx8716\Macro1.swb - Makro aufgezeichnet am 19.02.14 von jfaradon

' ******************************************************************************

Dim swApp als SldWorks.SldWorks

 

Hier ist ein Beispiel für ein Makro, das eine Komponente durch Auswahl durch eine andere ersetzt (Sie müssen den Namen angeben)

 

 

Dim swDoc As SldWorks.ModelDoc2

Dim swAss As SldWorks.AssemblyDoc

Dim stOldFileName As String, stNewFileName As String

Dim bStatus als boolescher Wert

 

Sub main()

 

    Legen Sie swApp = Application.SldWorks fest

    Festlegen von swDoc = swApp.ActiveDoc

    

    Wenn swDoc nichts ist, dann sub beenden

    Wenn swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY, dann sub beenden

    

    Setze swAss = swDoc

    stOldFileName = swApp.GetCurrentMacroPathFolder & "\370-TreeManager\370-Burner.SLDPRT"

    stNewFileName = swApp.GetCurrentMacroPathFolder & "\370-TreeManager\370-Burner - Copy.SLDPRT"

    

    swDoc.Extension.SelectByID2 "370-Brenner-1@370-Brenner", "KOMPONENTE", 0, 0, 0, Falsch, 0, Nichts, swSelectOption_e.swSelectOptionDefault

    bStatus = swAss.ReplaceComponents(stNewFileName, "", True, True)

 

    swDoc.Extension.SelectByID2 "370-Brenner - Copy-1@370-Torch", "KOMPONENTE", 0, 0, 0, Falsch, 0, Nichts, swSelectOption_e.swSelectOptionDefault

    bStatus = swAss.ReplaceComponents(stOldFileName, "", True, True)

 

 

Ende Sub

8 „Gefällt mir“
3

Hallo an dich jfaradon =)

 

Wenn ich das Makro richtig verstanden habe, würde es dem Benutzer so etwas geben, um den Teil im Baum auszuwählen und denjenigen, der ihn ersetzen soll:

 

 

Dim swDoc As SldWorks.ModelDoc2

Dim swAss As SldWorks.AssemblyDoc

Dim stNewFileName As String

Dim bStatus als boolescher Wert

Dimmen Sie ein Stück als Schnur

Dim assem als String

 

 

 

Sub main()

 

    Legen Sie swApp = Application.SldWorks fest

    Festlegen von swDoc = swApp.ActiveDoc

   piece= InPutBox("Name des zu ändernden Teils")

    assem =InPutBox("Name der offenen Assembly")

    Pfad= InPutBox("Pfad des Ersatzteils")

    Piecebis=InPutBox("Name des Ersatzteils")

    

    Wenn swDoc nichts ist, dann sub beenden

    Wenn swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY, dann sub beenden

    

    Setze swAss = swDoc

    stNewFileName = Pfad & piecebis & ". SLDPRT"

 

    

    swDoc.Extension.SelectByID2 Stück & "@" & assem, "KOMPONENTE", 0, 0, 0, Falsch, 0, Nichts, swSelectOption_e.swSelectOptionDefault

    bStatus = swAss.ReplaceComponents(stNewFileName, "", True, True)

 

Ende Sub

 

PS: Ja, ich muss zugeben, dass ich im zweiten Teil nicht alles verstanden habe^^'

4

Ja, das war's...

und in der Tat habe ich das Ende des Codes nicht bereinigt, die letzten Zeilen sind nutzlos ...

Tatsächlich ersetzt die ReplaceComponents-API die ausgewählte Komponente durch die angegebene Datei

 

 

4 „Gefällt mir“
5

Es ist seltsam, es spielt keine Rolle, ich habe gerade die Auswahl auch mit einem getpathname am Ende ausprobiert, um zu sehen, ob das Teil ausgewählt wurde, und es nimmt mich aus der Baugruppe in der msgbox...

 

Als ob die Variable swDoc auf dem swApp.activeDoc-Wert geblieben wäre

6

Hallo ihr alle!

 

Noch in meiner Forschung!

 

Ich habe die Funktion .getbyname ausprobiert, die funktioniert hat, aber die replacecomponents haben nicht gewirkt

 

Ich habe auch versucht, das Beispiel der Solidworks-Hilfe zu ändern, aber vergeblich =(

 

Makro-Operation:

 

"Wählen Sie ein Teil im Gebäudebaum aus

  Pfad + Name des Ersatzteils angeben
  Ersetzen Sie das Wellenteil durch das Ersatzteil."

 

Das Makro, das ich gerade habe, zeigt mir keine Fehler an. aber.... macht auch nichts :verrückt:

 

 

Sub main()

 
path = InputBox("Pfad des Ersatzteils")

piecebis = InputBox("Name des Ersatzteils")
stnewfilename = Pfad & piecebis &". SLDPRT"

   

Set swApp = CreateObject("SldWorks.Application")
    Festlegen von swComp = swApp.ActiveDoc
    Festlegen von swModel = swApp.ActiveDoc

    Set swAssy = swModel
bstatus = swComp.Extension.SelectByID2("00-XXXXX-0-Came-1@swAssy", "KOMPONENTE", 0, 0, 0, Falsch, 0, Nichts, 0)

   

MsgBox (swComp.GetPathName)
   

bstatus = swAssy.ReplaceComponents("C:\PDM\11 SIMULATION\01 Kontinuierlicher Kartonierer\Produkteinführung\00-XXXXX-0-Nockenrücklaufplan. SLDPRT", "02", Falsch, Wahr)

 

MsgBox (swComp.GetPathName)
 
 swAssy.ForceRebuild

 

 

Ende Sub