从图中保存模型

发布于 2025-01-23 06:40:26 字数 1268 浏览 2 评论 0原文

我有VBA代码要发出图纸。它允许更改模型的属性,问题,发行日期等。

这个想法是打开图形,更新问题,日期等(另存为PDF和DWG)。它有效,属性更改并保存正确的视图。

属性更改并不能保存到模型,除非我打开模型并强制保存,否则当我重新打开图纸/模型时,它们还原为旧。
即使该模型不打开,我该如何施加保存?

请参阅最后几行,以获取我的尝试:

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

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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

新雨望断虹 2025-01-30 06:40:26

抱歉...我的脸上滴了一点点鸡蛋...这无需分开零件和集会:(

这似乎有效...如果对VBA的侮辱,我很抱歉。
您只需要打开图纸,而不是零件或组件:)对不起无法抗拒。

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

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
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文