Ik heb een macro gemaakt op Solidworks waarmee je een lijst met assemblages kunt ophalen, ze kunt verplaatsen en ze kunt opslaan als sldw-assemblages en IFC's.
Het programma werkt echter in de gegenereerde IFC's, alle elementen die opzettelijk grijs zijn gemaakt in de assemblages zijn zichtbaar.
Wanneer ik handmatig een IFC opsla krijg ik een bericht met de vraag of ik de verborgen/verwijderde elementen wil oplossen, ik vink nee aan en ik krijg het gewenste resultaat.
Weet u hoe u dit vakje automatisch kunt aanvinken in VBA ?
Enum IfcFormat_e
Ifc2x3 = 23
Ifc4 = 4
End Enum
Const OUT_FILE_PATH As String = "C:\Test.ifc"
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
ExportIfc swModel, OUT_FILE_PATH, IfcFormat_e.Ifc4
Else
MsgBox "Please open the model"
End If
End Sub
Sub ExportIfc(model As SldWorks.ModelDoc2, path As String, format As IfcFormat_e)
Dim curIfcFormat As Integer
curIfcFormat = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swSaveIFCFormat)
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swSaveIFCFormat, format
Dim errors As Long
Dim warnings As Long
If False = model.Extension.SaveAs3(path, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, Nothing, errors, warnings) Then
Err.Raise vbError, "", "Failed to export file. Error code: " & errors
End If
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swSaveIFCFormat, curIfcFormat
End Sub
Dit bericht wordt niet opgevangen door de functie opslaan. SW activeert het verwijderde onderdeel opnieuw en plotseling is de export "niet compliant" met wat Ka.Couff wil .
Dit is geen configuratieprobleem, dus de respons is niet voldoende ;)
We moeten kijken naar SW-evenementen als we deze boodschap kunnen oppikken en een behandeling kunnen doen.
Ja, dat is het Ik had geprobeerd de macro op te nemen door de manipulatie handmatig te starten, maar er is niets dat het bericht weergeeft:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' Save As
longstatus = Part.SaveAs3("XXX.IFC", 0, 0)
End Sub
Ik heb op dit moment niet veel tijd om hiernaar te kijken, maar als je het bericht niet kunt onderscheppen, is er altijd de mogelijkheid om het onderdeel in de verwijderde staat te verwijderen, de export uit te voeren en te sluiten zonder op te slaan.
Het is mogelijk dat de API op dit moment geen toegang tot dit bericht toestaat (SW voegt toegang tot functies toe wanneer SW wordt vrijgegeven).
