Search code examples
vbasavesolidworks

Save model from drawing


I have VBA code to issue drawings. It allows properties of the model to be changed, issue, date of issue etc.

The idea is to open the drawing, update issue, date, etc. (save as pdf and dwg). It works, properties changed, and saves the correct view.

The property changes are not saved to the model, unless I open the model and force a save, hence when I reopen the drawing/model they revert to the old.
How can I force a save of the model, even if it is not open?

See last few lines for my attempt:

Sub WriteModelProperties(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)
Dim element As Integer
Dim boolstatus As Boolean
Dim ctrl As MSForms.Control
Dim fieldName As String
Dim fieldType As Integer
Dim fieldValue As String

For element = 0 To 25
    fieldName = propertiesValue(0, element)
    Select Case propertiesValue(1, element)
        Case "Text": fieldType = 30
        Case "Date": fieldType = 64
    End Select
    Set ctrl = UserForm1.Controls(propertiesValue(2, element)) 'to make a compact code
        
    Select Case propertiesValue(3, element)
        Case "Caption": fieldValue = ctrl.Caption
        Case "Value": fieldValue = ctrl.Value
    End Select
    Debug.Print fieldValue
    boolstatus = swCustProp.Add3(fieldName, fieldType, fieldValue, swCustomPropertyDeleteAndAdd)
Next element

swModel.Rebuild (swRebuildAll)
swModel.EditRebuild3 ' Update model properties     
swModel.ViewZoomtofit2
boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End Sub

Solution

  • Sorry ... tad bit of egg on my face ... it didnt work had to split parts and assemblies :(

    This appears to work ... my apologies if its an insult to vba. You only need to open the drawing, not the part or assembly :) Sorry couldn't resist.

    Option Explicit
        Public swApp        As SldWorks.SldWorks
        Public swModDoc     As SldWorks.ModelDoc2
        Dim swView          As SldWorks.View
        Dim swPart          As PartDoc
        Dim swAss           As AssemblyDoc
        Dim boolstatus      As Boolean
        Dim lErrors         As Long 'Varaible to collect Errors
        Dim lWarnings       As Long 'Varaible to collect Errors
            
    Sub main()
    
        Set swApp = Application.SldWorks
        Set swModDoc = swApp.ActiveDoc
        Set swView = swModDoc.GetFirstView
        Set swView = swView.GetNextView
        
        If swView.ReferencedDocument.GetType = 1 Then
            Set swPart = swView.ReferencedDocument
            boolstatus = swPart.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
        ElseIf swView.ReferencedDocument.GetType = 2 Then
            Set swAss = swView.ReferencedDocument
            boolstatus = swAss.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
        End If
    End Sub