I have a VBA macro that allows me to issue drawings - as part of this, it allows properties of the model to be changed, issue, date of issue etc.
The idea is just to open the drawing, update issue, date, etc (save as pdf and dwg) - it works, properties changed, and saves the correct view.
But 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.
Does anyone know how can I force a save of the model, even if it is not open. See last few lines for my feeble 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
CodePudding user response:
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