Jump to content

Макрос. Пакетное сохранение определённых файлов в формат IGS


UnrealPV

Recommended Posts

UnrealPV

Есть макрос который сохраняет все детали входящие в сборку в формат .STEP (и на другой можно поменять). Подскажите как бы его доработать чтобы он сохранял только детали у которых во вкладке "Настройки" свойство "Тип" = Труба?

Заранее огромное спасибо!

Код макроса:

 

 

 

 

'**********************
'Copyright(C) 2022 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/import-export/export-multi-formats/
'License: https://www.codestack.net/license/
'**********************

Const ALL_CONFIGS As Boolean = False
Const OUT_FOLDER As String = ""
Const STEP_VERSION As Long = 214 '203 or 214

Dim OUT_NAME_TEMPLATES As Variant

Dim swApp As SldWorks.SldWorks

Sub main()
        
    Dim origStepVersion As Long
        
    OUT_NAME_TEMPLATES = Array("PDFs\<_FileName_>_<_ConfName_>_<PartNo>.pdf", "IMGs\<_FileName_>_<_ConfName_>_<PartNo>.jpg")
    
    Set swApp = Application.SldWorks
    
try_:
    On Error GoTo catch_
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        Err.Raise vbError, "", "Please open document"
    End If
    
    If swModel.GetPathName() = "" Then
        Err.Raise vbError, "", "Please save the model"
    End If
    
    Dim outFolder As String
    
    If Not TryGetOutDirFromArguments(outFolder) Then
        outFolder = OUT_FOLDER
    End If
    
    ReadOptions origStepVersion
    SetupOptions STEP_VERSION
    
    ExportFile swModel, OUT_NAME_TEMPLATES, ALL_CONFIGS, outFolder
    
    GoTo finally_
    
catch_:
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
finally_:

    SetupOptions origStepVersion

End Sub

Sub ReadOptions(ByRef stepVersion As Long)

    stepVersion = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP)
    
End Sub

Sub SetupOptions(stepVersion As Long)
    
    If False = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP, stepVersion) Then
        Err.Raise vbError, "", "Failed to set Step Export version to " & stepVersion
    End If
    
End Sub

Sub ExportFile(model As SldWorks.ModelDoc2, vOutNameTemplates As Variant, allConfigs As Boolean, outFolder As String)
    
    Dim i As Integer
    Dim j As Integer
    
    Dim curConf As String
    
    If model.GetType() = swDocumentTypes_e.swDocDRAWING Then
        Dim swDraw As SldWorks.DrawingDoc
        Set swDraw = model
        curConf = swDraw.GetCurrentSheet().GetName
    Else
        curConf = model.ConfigurationManager.ActiveConfiguration.Name
    End If
    
    Dim vConfs As Variant
    
    If allConfigs Then
        If model.GetType() = swDocumentTypes_e.swDocDRAWING Then
            vConfs = model.GetSheetNames()
        Else
            vConfs = model.GetConfigurationNames()
        End If
    Else
        Dim sConfs(0) As String
        sConfs(0) = curConf
        vConfs = sConfs
    End If
    
    For i = 0 To UBound(vConfs)
    
        If model.GetType() = swDocumentTypes_e.swDocDRAWING Then
            curConf = swDraw.ActivateSheet(CStr(vConfs(i)))
        Else
            model.ShowConfiguration2 CStr(vConfs(i))
        End If
                
        For j = 0 To UBound(vOutNameTemplates)
            
            Dim errs As Long
            Dim warns As Long
        
            Dim outNameTemplate As String
            outNameTemplate = vOutNameTemplates(j)
            
            Dim outFilePath As String
            outFilePath = ComposeOutFileName(outNameTemplate, model, outFolder)

            Dim outDir As String
            outDir = Left(outFilePath, InStrRev(outFilePath, "\"))
    
            CreateDirectories outDir
    
            If False = model.Extension.SaveAs(outFilePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errs, warns) Then
                Err.Raise vberrror, "", "Failed to export to " & outFilePath
            End If
            
        Next
        
    Next
    
    If model.GetType() = swDocumentTypes_e.swDocDRAWING Then
        curConf = swDraw.ActivateSheet(curConf)
    Else
        model.ShowConfiguration2 curConf
    End If
    
End Sub

Function ComposeOutFileName(template As String, model As SldWorks.ModelDoc2, outFolder As String) As String

    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.Pattern = "<[^>]*>"
    
    Dim regExMatches As Object
    Set regExMatches = regEx.Execute(template)
    
    Dim i As Integer
    
    Dim outFileName As String
    outFileName = template
    
    For i = regExMatches.Count - 1 To 0 Step -1
        
        Dim regExMatch As Object
        Set regExMatch = regExMatches.Item(i)
                    
        Dim tokenName As String
        tokenName = Mid(regExMatch.Value, 2, Len(regExMatch.Value) - 2)
        
        outFileName = Left(outFileName, regExMatch.FirstIndex) & ResolveToken(tokenName, model) & Right(outFileName, Len(outFileName) - (regExMatch.FirstIndex + regExMatch.Length))
    Next
    
    ComposeOutFileName = ReplaceInvalidPathSymbols(GetFullPath(model, outFileName, outFolder))
    
End Function

Function ReplaceInvalidPathSymbols(path As String) As String
    
    Const REPLACE_SYMB As String = "_"
    
    Dim res As String
    res = Right(path, Len(path) - Len("X:\"))
    
    Dim drive As String
    drive = Left(path, Len("X:\"))
    
    Dim invalidSymbols As Variant
    invalidSymbols = Array("/", ":", "*", "?", """", "<", ">", "|")
    
    Dim i As Integer
    For i = 0 To UBound(invalidSymbols)
        Dim invalidSymb As String
        invalidSymb = CStr(invalidSymbols(i))
        res = Replace(res, invalidSymb, REPLACE_SYMB)
    Next
    
    ReplaceInvalidPathSymbols = drive + res
    
End Function

Function ResolveToken(token As String, model As SldWorks.ModelDoc2) As String
    
    Const FILE_NAME_TOKEN As String = "_FileName_"
    Const CONF_NAME_TOKEN As String = "_ConfName_"
    
    Select Case LCase(token)
        Case LCase(FILE_NAME_TOKEN)
            ResolveToken = GetFileNameWithoutExtension(model.GetPathName)
        Case LCase(CONF_NAME_TOKEN)
            If model.GetType() = swDocumentTypes_e.swDocDRAWING Then
                Dim swDraw As SldWorks.DrawingDoc
                Set swDraw = model
                ResolveToken = swDraw.GetCurrentSheet().GetName
            Else
                ResolveToken = model.ConfigurationManager.ActiveConfiguration.Name
            End If
        Case Else
            
            Dim swCustPrpMgr As SldWorks.CustomPropertyManager
            Dim resVal As String
            resVal = ""
            
            If model.GetType() <> swDocumentTypes_e.swDocDRAWING Then
                Set swCustPrpMgr = model.Extension.CustomPropertyManager(model.ConfigurationManager.ActiveConfiguration.Name)
                swCustPrpMgr.Get2 token, "", resVal
            End If
            
            If resVal = "" Then
                Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
                swCustPrpMgr.Get2 token, "", resVal
            End If
            
            ResolveToken = resVal
    End Select
    
End Function

Function GetFileNameWithoutExtension(path As String) As String
    
    GetFileNameWithoutExtension = Mid(path, InStrRev(path, "\") + 1, InStrRev(path, ".") - InStrRev(path, "\") - 1)
    
End Function

Function FileExists(filePath As String) As Boolean
    FileExists = Dir(filePath) <> ""
End Function

Sub CreateDirectories(path As String)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FolderExists(path) Then
        Exit Sub
    End If

    CreateDirectories fso.GetParentFolderName(path)
    
    fso.CreateFolder path
    
End Sub

Function GetFullPath(model As SldWorks.ModelDoc2, path As String, outFolder As String)
    
    GetFullPath = path
        
    If IsPathRelative(path) Then
        
        If Left(path, 1) <> "\" Then
            path = "\" & path
        End If
        
        If outFolder = "" Then
        
            Dim modelPath As String
            Dim modelDir As String
            
            modelPath = model.GetPathName
            
            modelDir = Left(modelPath, InStrRev(modelPath, "\") - 1)
            
            outFolder = modelDir
        Else
            If Right(outFolder, 1) = "\" Then
                outFolder = Left(outFolder, Len(outFolder) - 1)
            End If
        End If
        
        GetFullPath = outFolder & path
        
    End If
    
End Function

Function IsPathRelative(path As String)
    IsPathRelative = Mid(path, 2, 1) <> ":" And Not IsPathUnc(path)
End Function

Function IsPathUnc(path As String)
    IsPathUnc = Left(path, 2) = "\\"
End Function

Function TryGetOutDirFromArguments(ByRef outDir As String) As Boolean

try_:

    On Error GoTo catch_

    Dim macroRunner As Object
    Set macroRunner = CreateObject("CadPlus.MacroRunner.Sw")
    
    Dim param As Object
    Set param = macroRunner.PopParameter(swApp)
    
    Dim vArgs As Variant
    vArgs = param.Get("Args")
    
    outDir = CStr(vArgs(0))
    TryGetOutDirFromArguments = True
    GoTo finally_
    
catch_:
    TryGetOutDirFromArguments = False
finally_:

End Function

Link to post
Share on other sites


UnPinned posts
Sturmann

Можно например у автора спросить или попросить его это сделать

Link to post
Share on other sites
17.09.2022 в 14:08, UnrealPV сказал:

Подскажите как бы его доработать чтобы он сохранял только детали у которых во вкладке "Настройки" свойство "Тип" = Труба?

Как вариант:

Цитата

  ...

          Dim swCustPrpMgr As SldWorks.CustomPropertyManager

            Dim ValOut As String
            Dim ReesolvedValOut As String

            ValOut = ""
                Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
                swCustPrpMgr.Get2 "Тип", ValOut , ReesolvedValOut 

if ValOut = "Труба" then

            If False = model.Extension.SaveAs(outFilePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errs, warns) Then
                Err.Raise vberrror, "", "Failed to export to " & outFilePath
            End If

end if

...

 

17.09.2022 в 14:08, UnrealPV сказал:
Цитата

This service is not available in your country

Этот сервис недоступен в вашей стране

 

  • Нравится 1
  • Чемпион 1
Link to post
Share on other sites
Snake 60
10 минут назад, Kelny сказал:

This service is not available in your country

Этот сервис недоступен в вашей стране

VPN в помощь...

Link to post
Share on other sites
UnrealPV
13 часов назад, Kelny сказал:

Как вариант:

 

 

Спасибо! Решил это кое-как похожим способом, через кучу костылей) надо будет по-вашему переделать.

Но оказывается этот макрос экспортирует только активный документ, а не все детали входящие в сборку, как я думал. Нашёл макрос Batch+, через него вроде неплохо запускать для всех входящих в сборку деталей.

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    No registered users viewing this page.




  • Сообщения

    • AlexKaz
      Ls-Dyna, Pamstamp, Autoform. Что-то ещё. На крайний случай (будет муторно и долго): Ansys, Code_Aster, CalculiX, SolidWorks Simulation. QForm для листовой очень так себе.   Возможно, Вам будет проще отдать расчёт на сторону (например, мне), недорого.
    • Udav817
      Скорее всего это надо искать в функционале модулей по расчёту деформаций. В общем, это сопромат. Моделировать окажется сильно дольше, чем провести эксперимент. Да и моделирование без эксперимента будет неточным.
    • Udav817
      Несколько это сколько? Я вижу только 2 детали. Большой контур, который делается замкнутым и маленькая скоба внутри. Ну, большой контур можно конечно сделать из двух частей, если технология не позволяет согнуть так, чтобы замкнуть и стык сварить. Тогда будет 3 "куска". И это не зависит от того, в скольки плоскостях гиб. Только от качества гибочного инструмента и опыта слесаря.   Длина развёртки может быть неточной только если пруток при гибке плохо зафиксирован. А так на таких габаритах плюс-минус 2 мм максимум (на большой детали). "схему гибки" придётся чертить вручную. CAD здесь поможет только размерами отрезков и дуг из эскиза. Как вариант, можно просто на видах указывать размеры от одной точки. Вручную, разумеется. Тогда будет больше ясности какой элемент идёт следующим. А если начертить прямой кусок и на нём нанести размеры, это не будет так наглядно. Это всё же не листовой материал и разницу надо понимать.
    • Udav817
      Проверяй права админа. И если библиотеки на сервере, там может быть настроен откат из резервной копии. 
    • раздватри
      Хорошо, прекращаем, но по ссылке я обнаружил только бред о крыльях пчел. А ведь они жужжат и возможно на звуковых волнах висят. Как вам этот бред ... Любое неисследованное явление должно быть сперва показано, а потом исследовано и очень редко наоборот, случайно. Ничего этого нет и быть не должно. Только бабка-Яга и на швабре - сказка словом.
    • Krusnik
      Подниму некропост. Решил я сделать себе CREO c блэкджеком и шлюхами со своим Hole. GOST.hol   Но уткнулся в следующее.  В hol файле есть фаски, и я внес в него заходные фаски под резьбу. Но нужны ещё фаски и под потай, плюс цековки под винты, болты. И все они разные.   Как удобнее делать это в CREO? Делать отдельные файлы типа 17475.hol?
    • MAXIKOT
      Я скачал триальную версию. Может я что-то не так делаю, но в списке файлов постпроцессора мне что нужно выбрать для этого?   да как тут картинку то вставить в сообщение, блин. https://thumb.cloud.mail.ru/thumb/xw1/new.jpg
    • НиколайП
      Картинки нет. Полосовой профиль - это банальная полоса, узкий длинный лист. Свободная кромка - та, что не сварена с листом настила. Вот как это может выглядеть (только пример, нет реальной задачи).   Стандарт требует пускать по свободной кромке фиктивный стержневой элемент, вот так:   Зачем это нужно? Зачем в этом несуществующем элементе измерять напряжения? Пояснений я в правилах РМРС не вижу.  Когда DNV рекомендует пускать стержень по краю мембранного элемента для устранения сингулярности - это понятно. Когда наш регистр пихает в правила не обработанный текст из Гугл-переводчика - непонятно.
    • sazewar
      Всем доброго времени суток! Объясните, пожалуйста, нубу (может не очень внимательно читал, но всё же) В общем, задача такая, внедрить Teamcenter (или другую pdm-систему, главное чтобы была с интеграцией solidworks или NX), как минимум, на 3 компа (а лучше на 10).  Как я понял, нужно следующее: 1) На одном из компов устанавливаем серверное ПО (Windows Server 2012R2 x64 + MS SQL Server 2012 SP2 x64 и еще что-то). На это всё устанавливаем Teamcenter, серверную часть.  2) Затем устанавливаем клиентские части тимцентра на другие компы. 3) Тут главный вопрос. Как их связать, чтобы мы друг друга видели? Ну то есть, через локалку, или еще как-то? Ну чтобы сосед подключился к моему серверу, и мы начали работать в одной базе, как положено. Нигде, в инструкциях я на этот вопрос ответа не нашел.  4) Как подвязать NX в этот Тимцентр (а лучше еще и solidworks)?  В общем, не нашел в теме ответ, как связать несколько тимцентров между собой. Догадки есть конечно, но просвятите пожалуйста.
    • a_schelyaev
      Вы знаете, вы мне напоминаете человека, который решил все измерения любых величин приводить к мм размерности, для чего ему пришлось вводить дополнительные коэффициенты "обрезающие" ед изм до мм. Вам говорят "зачем?", а вы в ответ "потому что я очень умный!". И вот стоит он, доказывает какой он умный себе на уме.
×
×
  • Create New...