Сохранять файлы с серийными номерами

[mme 10]

Здравствуйте.
Я написал небольшой макрос, который позволяет вам сохранять файлы с серийными номерами до 99.
Надеюсь вас понравится.

 

Option Explicit

Dim swApp   As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim saveFileName    As String
Dim nErrors As Long
Dim nWarnings   As Long
Dim vnam    As String
Dim vbool   As Boolean
Dim i   As Long

Sub main()
      
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
  
    For i = 1 To 99
        saveFileName = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "~" & Format(i, "00")
        vnam = Dir(saveFileName & ".jpg")
        If vnam = "" Then
            swModel.Extension.SaveAs saveFileName & ".jpg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
            vnam = Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "~" & Format(i, "00") & ".jpg"
            vbool = MsgBox(swModel.GetPathName & vbCr & vbCr & "->   " & vnam, vbOKOnly, "Saved As:")
            Exit For
        End If
    Next i
    
End Sub
 

[Kir95 950]

2 часа назад, mme сказал:

макрос, который позволяет вам сохранять файлы с серийными номерами до 99

Сохраняет, как файл картинки. Удобно, спасибо.

[Grig75 108]

2 часа назад, mme сказал:

Надеюсь вас понравится.

Простенький, но действительно полезный макрос.

[Maik812 289]

Конечно спасибо за работу и макрос, ток не понятно а что дает серийный номер и картинка ? И зачем это?

 

[Snake 60 684]

4 часа назад, Maik812 сказал:

Конечно спасибо за работу и макрос, ток не понятно а что дает серийный номер и картинка ? И зачем это?

 

Я, например, его немножко изменил (сохраняю в png и поменял текст) и использую для регистрации изменений. При сравнении двух картинок визуально видно что поменялось в детали. По-моему, удобно.

 Option Explicit

Dim swApp   As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim saveFileName    As String
Dim nErrors As Long
Dim nWarnings   As Long
Dim vnam    As String
Dim vbool   As Boolean
Dim i   As Long

Sub main()
      
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
  
    For i = 1 To 99
        saveFileName = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "~ Изм. " & Format(i, "00")
        vnam = Dir(saveFileName & ".png")
        If vnam = "" Then
            swModel.Extension.SaveAs saveFileName & ".png", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
            vnam = Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "~ Изм. " & Format(i, "00") & ".png"
            vbool = MsgBox(swModel.GetPathName & vbCr & vbCr & "->   " & vnam, vbOKOnly, "Внешний вид модели сохранен как:")
            Exit For
        End If
    Next i
    
End Sub

 

Изменено 10 июня 2019 пользователем Snake 60

[Maik812 289]

7 минут назад, Snake 60 сказал:

и использую для регистрации изменений

И где хранишь изменения? а фото то зачем? и где хранить..

[Snake 60 684]

7 минут назад, Maik812 сказал:

И где хранишь изменения? а фото то зачем? и где хранить..

В картинках и хранятся. Это же не ЕСКД  догма. Извещения не выпускаю, чисто для себя - визуализация, чтобы понять как поменялась модель.

[mme 10]

Идея состоит в том, что один объект можно рассматривать из нескольких стран и дать визуальное представление о себе. Да, это не соответствует ECКД

 

[Maik812 289]

Ну а че в потоке то не хранить ? И не потеряешь и вытащить и в писать можно автоматом до 9 ячеек всякими значениями заполнить? просто интересно...

mPDM.zip

 

 

Изменено 11 июня 2019 пользователем Maik812

[Snake 60 684]

@Maik812 Спасибо за плагин, не знал про него. Я не часто использую ТС, но может именно этот плагин приживется у меня :)

[Maik812 289]

1 минуту назад, Snake 60 сказал:

но может именно этот плагин приживется у меня :)

ini открой плагина и заполни что нужно еще тебе. но первые не трогай значения. хотя смотри сам.