Jump to content

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


sfedotovs

Recommended Posts

sfedotovs

Всем привет. Нужна помощь с макросом. Сам макрос сохраняет выбранные комплектующие детали или сборки в 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
 

Link to post
Share on other sites


UnPinned posts
Sturmann

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

Link to post
Share on other sites
Kelny
22.01.2024 в 09:52, sfedotovs сказал:

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

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

 

 

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.




×
×
  • Create New...