VBA-code voor het wijzigen van de referentie bij het openen van een . SLDPRT

Onder de code moet het de 2 objecten ophalen die toch goed geselecteerd zijn in solidworks!

Expliciete optie

'Dim swApp als object
Dim swApp als SldWorks.SldWorks
'Dim deel als object
Dim deel als SldWorks.ModelDoc2

Dimfunctie als object
Dim vBody als variant
Dim boolstatus als Booleaanse
Dim longstatus Zo lang
Dim lange waarschuwingen zo lang mogelijk
Dim FeatureName als tekenreeks
Dim bestandsnaam als tekenreeks
Dim fileconfig als tekenreeks
Dim filedispname als tekenreeks
Dim bestandsopties zo lang
Dim Filter Als String
Dim stuk als snaar
Dim swModExt als SldWorks.ModelDocExtension
Dim swBody As SldWorks.Body2
Dim sBodySelStr als snaar
Dim sBodyTypeSelStr als snaar
Zon i Zo lang
Dim bRet als Booleaanse
Dim resultaat als tekenreeks

Sub Combiner()
    'Stel swApp = Application.SldWorks in

'Herstel de actieve SolidWorks-instantie
Stel swApp = GetObject(, "SldWorks.Application") in

'Hiermee kunt u de SolidWorks-applicatie bekijken.
swApp.Visible = Waar
Als swApp niets is, dan
Stel swApp = CreateObject("SldWorks.Application") in
swApp.Visible = Waar
Einde als
   
    MsgBox ("Hoofdbestand selectie!" & vbCrLf & "Hoofdbestand selectie!")

    Filter = "Solidworks-bestanden (*.sldprt; *.sldasm)|*.sldprt;*.sldasm"
    Opent het bovenliggende bestand
    filename = swApp.GetOpenFilename("Het bovenliggende bestand selecteren", "", Filter, fileoptions, fileconfig, filedispname)
   
    Deel instellen = swApp.OpenDoc6(bestandsnaam, 1, 0, "", longstatus, longwarnings)
    Functie instellen = Deel.FirstFeature
   
    Hoewel geen functie niets is
        FeatureName = Feature.Name
        Als Feature.GetTypeName2 = "Voorraad" dan
            Stuk = FunctieNaam
        Einde als
        Functie instellen = Functie.GetNextFeature()
    Gaan
   
    'Verwijdert het bestand 'deel van het lichaam'
    boolstatus = Part.Extension.SelectByID2(Stuk, "BODYFEATURE", 0, 0, 0, False, 0, Niets, 0)
    Deel.BewerkenVerwijderen
   
    MsgBox ("Selecteer deel om af te trekken!" & vbCrLf & "Selecteer deel om af te trekken!")
   
    Opent het bestand om af te trekken
    filename = swApp.GetOpenFilename("Het bestand selecteren om af te trekken", "", Filter, fileoptions, fileconfig, filedispname)
    Functie instellen = Part.InsertPart2(bestandsnaam, 15)
          
    vBody = Deel.GetBodies2(swSolidBody, waar)
    SelectBodies swApp, Deel, vBody
               
    'Functie instellen = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, Niets, niets)
    Sun SelMgr Als SelectieMgr
    Set SelMgr = Part.SelectionManager
    Functie instellen = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, SelMgr.GetSelectedObject6(1, 1), SelMgr.GetSelectedObject6(1, 2))
   
Einde Sub

Sub SelectBodies(swApp als SldWorks.SldWorks, swModel als SldWorks.ModelDoc2, vBody als variant)


    Als IsEmpty(vBody) sluit dan Sub af
    Stel swModExt = swModel.Extension in
    Voor i = 0 TB UBound(vBody)
        Stel swBody in = vBody(i)
        sBodySelStr = swBody.GetSelectionId
        resultaat = sBodySelStr
        Als InStr(resultaat, ">-<") Dan
            bRet = swModExt.SelectByID2(resultaat, "SOLIDBODY", 0#, 0#, 0#, Waar, 2, Niets, 0)
        Anders
            bRet = swModExt.SelectByID2(resultaat, "SOLIDBODY", 0#, 0#, 0#, True, 1, Niets, 0)
        Einde als
    volgende i
       
Einde Sub

Hallo

Hoe start je je macro?

Ik heb je macro in zijn geheel overgenomen en het werkt heel goed op mijn computer.

Vriendelijke groeten

Ik voer het uit vanuit selectievakjes in gebruikersformulieren, ik heb ook geprobeerd het live uit te voeren vanuit de VBA-editor, maar nog steeds dezelfde bug.

Aan de andere kant voert degene die je hebt gestuurd perfect uit.

Vriendelijke groeten.

Controleer bij alle gevaren of u niet meerdere Solidworks-processen heeft uitgevoerd. Ik kan de bug die je hebt op 2 verschillende pc's niet reproduceren, dus het is moeilijk om je te vertellen waar het vandaan zou kunnen komen.

Hallo

Zou het niet op "SelectBodies swApp, Part, vBody" zijn dat het crasht?

Debug stap voor stap om te zien wat er mis is.

Deze melding verschijnt wanneer een functie een object gebruikt dat gelijk is aan niets.

1 like

Hallo d.roger, Yves.T !

Dat is het, alles werkt!!

De bug kwam voort uit het feit dat er niet-aangevinkte Solidworks-referenties waren in de tooloptie van de VBA, wat daarom een communicatieprobleem met de software zou moeten veroorzaken.

Dus heb ik alle scheidsrechters geselecteerd. Solidworks en ik zullen later kijken om te bepalen wie de schuldige was. (Ik heb je voor informatie in bijlagen de refs die ontbraken)

Nogmaals, hartelijk dank voor de relevantie van al uw adviezen en ondersteuning voor de oplossing van dit probleem, en d.roger blijft op deze manier "knutselen"!! ☺


lyncoa_20171016.gif