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

[sfedotovs 0]

Всем привет. Нужна помощь с макросом. Сам макрос сохраняет выбранные комплектующие детали или сборки в IGS формате. Не могу сделать так, чтобы название сохраняемых файлов из сборки бралось из названия активной конфигурации выбранного компонента. 

 

 

Sub SaveSelectedToIGS()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swView = swSelMgr.GetSelectedObject6(1, -1)
    
    Dim MySolidBodys() As String
    
    DocIsAssembly = LCase(Right(swModel.GetTitle, 6)) = "sldasm"
    If DocIsAssembly Then X_tupe = "COMPONENT" Else X_tupe = "SOLIDBODY"
    
    For i = 1 To 100
        If swSelMgr.GetSelectedObject6(i, -1) Is Nothing Then Exit For
        If swSelMgr.GetSelectedObject6(i, -1).AddPropertyExtension <> -1 Then 'Исключаем папки если нечайно выделили
            ReDim Preserve MySolidBodys(i - 1)
            MySolidBodys(i - 1) = swSelMgr.GetSelectedObject6(i, -1).Name
        Else
            k = k + 1
        End If
    Next i
    If i - k = 1 Then MsgBox ("Выделите тела или детали, которые нужно сохранить в IGS"): End
    If DocIsAssembly Then 'Cкрыть все
        SelectAllComponents
        swModel.HideComponent2
    Else
        swModel.ClearSelection2 True
        swModel.FeatureManager.HideBodies
    End If
    
    For Each X In MySolidBodys
        boolstatus = swModel.Extension.SelectByID2(X, X_tupe, 0, 0, 0, False, 0, Nothing, 0) 'Выделить
        If DocIsAssembly Then 'Показать нужный элемент
            swModel.ShowComponent2
        Else
            swModel.FeatureManager.ShowBodies
        End If
        swModel.ClearSelection2 True 'Снять выделение
        MyPathName = Left(swModel.GetPathName, Len(swModel.GetPathName) - Len(swModel.GetTitle)) & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "_" & X & ".IGS"
        longstatus = swModel.SaveAs(MyPathName)
        If DocIsAssembly Then 'Cкрыть все
            SelectAllComponents
            swModel.HideComponent2
        Else
            swModel.ClearSelection2 True
            swModel.FeatureManager.HideBodies
        End If
    Next X
    If DocIsAssembly Then 'Показать все
        SelectAllComponents
        swModel.ShowComponent2
    Else
        swModel.ClearSelection2 True
        swModel.FeatureManager.ShowBodies
    End If
    swModel.ClearSelection2 True

    Foldername = Left(swModel.GetPathName, Len(swModel.GetPathName) - Len(swModel.GetTitle)) '"\\server\Instructions\"
    Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
End Sub

Sub SelectAllComponents()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssy As SldWorks.AssemblyDoc
    Dim swChildComp As SldWorks.Component2
    Dim vChildComp As Variant
    Dim boolstatus As Boolean
    Dim i As Integer
    
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    
    vChildComp = swAssy.GetComponents(False)
    
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        boolstatus = swChildComp.Select3(True, Nothing)
    Next i
End Sub
 

[Sturmann 30]

Здравствуйте. Вам нужно загрузить менеджер конфигурации и ищ него уже получить либо текущую либо любую конфигурацию. 

[Kelny 1 285]

22.01.2024 в 09:52, sfedotovs сказал:

макрос сохраняет выбранные комплектующие детали или сборки в IGS формате.

Solidworks Task Scheduler пробовали?