[VBA]Selecteren uit de ontwerpstructuur

Macro
1

Hallo allemaal!

 

Na onderzoek en macro-opnamefunctie ben ik erin geslaagd om een onderdeel via macro te vervangen! =)

 

Het is cool, het werkt en je kunt alles door iets anders veranderen (je moet eigenlijk weten wat je op de montage doet)

 

Dat is allemaal goed en wel, maar... Ik was alleen in staat om een "GetSelectedObjectsComponent" =(

Dus het heen en weer tussen solidworks en excel om door te gaan (als er ooit meerdere vervangingen gemaakt moeten worden) is zonde.

 

Dus mijn vraag zou zijn: "Zou er een manier zijn in vba om een object in de ontwerpboom te selecteren?"

 

Zoals we bijvoorbeeld doen om een bestand in een map te selecteren, een variabele "bestandsnaam" die we in de code plaatsen zoals "open(bestandsnaam.sldprt)^^

 

Daar ga je, weer kom ik je lastig vallen, vergeef me

 

Vriendelijk

 

Yoann

2

Optie Expliciete

 

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

' C:\Users\jfaradon\AppData\Local\Temp\swx8716\Macro1.swb - macro opgenomen op 19/02/14 door jfaradon

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

Dim swApp als SldWorks.SldWorks

 

Hier is een voorbeeld van een macro die de ene component vervangt door een andere door selectie (je moet de naam opgeven)

 

 

Dim swDoc als SldWorks.ModelDoc2

Dim swAss als SldWorks.AssemblyDoc

Dim stOldFileName As String, stNewFileName As String

Dim bStatus als Booleaanse

 

Sub hoofd()

 

    Stel swApp = Toepassing.SldWorks in

    Stel swDoc in = swApp.ActiveDoc

    

    Als swDoc niets is, sluit dan Sub af

    Als swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY afsluit, sluit dan Sub af

    

    Stel swAss = swDoc in

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

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

    

    swDoc.Extension.SelectByID2 "370-Burner-1@370-Torch", "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

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

 

    swDoc.Extension.SelectByID2 "370-Burner - Copy-1@370-Torch", "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

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

 

 

Einde Sub

8 likes
3

Hallo aan jou jfaradon =)

 

Als ik de macro goed begreep, zou het zoiets als dit geven voor de gebruiker om het deel in de boom te kiezen en het deel dat het zal vervangen:

 

 

Dim swDoc als SldWorks.ModelDoc2

Dim swAss als SldWorks.AssemblyDoc

Dim stNewFileName als tekenreeks

Dim bStatus als Booleaanse

Dim stuk als snaar

Dim assem als snaar

 

 

 

Sub hoofd()

 

    Stel swApp = Toepassing.SldWorks in

    Stel swDoc in = swApp.ActiveDoc

   piece= InPutBox("Naam van het onderdeel dat moet worden gewijzigd")

    assem =InPutBox("Open Assembly Naam")

    Path= InPutBox("Pad voor vervangend onderdeel")

    Piecebis = InPutBox ("Naam vervangend onderdeel")

    

    Als swDoc niets is, sluit dan Sub af

    Als swDoc.GetType <> swDocumentTypes_e.swDocASSEMBLY afsluit, sluit dan Sub af

    

    Stel swAss = swDoc in

    stNewFileName = Pad & Piecebis & ". SLDPRT"

 

    

    swDoc.Extension.SelectByID2 Stuk & "@" & assem, "COMPONENT", 0, 0, 0, False, 0, Nothing, swSelectOption_e.swSelectOptionDefault

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

 

Einde Sub

 

PS: Ja, ik moet toegeven dat ik het tweede deel niet alles begreep^^'

4

Ja, dat is het...

en inderdaad, ik heb het einde van de code niet opgeruimd, de laatste regels zijn nutteloos ...

in feite vervangt de ReplaceComponents-API het geselecteerde onderdeel door het opgegeven bestand

 

 

4 likes
5

Het is vreemd, het maakt niet uit, ik heb net de selectie ook geprobeerd met een getpathname aan het einde om te zien of het het onderdeel heeft geselecteerd, en het haalt me uit de montage in de msgbox...

 

Alsof de swDoc variabele op de swApp.activeDoc waarde was blijven staan

6

Hoi allemaal!

 

nog steeds in mijn onderzoek!

 

Ik heb de .getbyname-functie geprobeerd, die werkte, maar de replacecomponents werkten niet

 

Ik heb geprobeerd het voorbeeld van de solidworks-hulp ook te wijzigen, maar tevergeefs =(

 

Macro operatie:

 

"Selecteer een onderdeel in de bouwboom

  Geef pad + naam van het reserveonderdeel
  Vervang het asdeel door het reserveonderdeel"

 

De macro die ik nu heb, laat me geen fouten zien. maar.... doet ook niets :crazy:

 

 

Sub hoofd()

 
pad = InputBox("Pad naar vervangend onderdeel")

piecebis = InputBox("Naam vervangend onderdeel")
stnewfilename = pad & stukbis &". SLDPRT"

   

Stel swApp = CreateObject("SldWorks.Application") in
    Stel swComp = swApp.ActiveDoc in
    Stel swModel = swApp.ActiveDoc in

    Stel swAssy in = swModel
bstatus = swComp.Extension.SelectByID2("00-XXXXX-0-Came-1@swAssy", "COMPONENT", 0, 0, 0, False, 0, Niets, 0)

   

MsgBox (swComp.GetPathName)
   

bstatus = swAssy.ReplaceComponents("C:\PDM\11 SIMULATION\01 Continuous Cartoner\Product Introduction\00-XXXXX-0-Cam Return Plan. SLDPRT", "02", Onwaar, Waar)

 

MsgBox (swComp.GetPathName)
 
 swAssy.ForceHerbouwen

 

 

Einde Sub