Сделай свою работу в Solidworks эффективнее

[dommast 2]

1 час назад, Kelny сказал:

Весь набор, что бы можно было поэкспериментировать с готовым набором файлов (простенькая сборка и чертёж к ней) и шаблонов ( используемый шаблон таблицы). Макрос вы уже выложили.

Вот в двух архивах. Не знаю как отправлять больше 1 мб, поэтому разбил.

Сборка.zip Чертеж.zip

[Snake 60 689]

@dommast

Цитата

' ******************************************************************************
' C:\Users\Aleksandr\AppData\Local\Temp\swx5968\Macro1.swb - macro recorded on 04/11/24 by Aleksandr
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim swActiveView As Object
Set swActiveView = Part.ActiveDrawingView
Dim swBOMTable As Object
Set swBOMTable = swActiveView.InsertBomTable4(False, 0.2, -0.02, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft, swBomType_e.swBomType_TopLevelOnly, "0", "C:\SW_Настройки\Шаблоны спецификаций\!А_Таблица Сборка.sldbomtbt", False, 0, False)
    If Not swBOMTable Is Nothing Then
       swBOMTable.BorderLineWeight = 0
       swBOMTable.GridLineWeight = 0
    End If
boolstatus = Part.EditRebuild3()
End Sub

Не благодарите :)

[dommast 2]

17 часов назад, Snake 60 сказал:

@dommast

Не благодарите :)

Тогда пусть это будет не благодарность, а простое человеческое спасибо.

Спасибо за уделенное время для решения моего вопроса.  

[Snake 60 689]

@dommast Никто не мешает поставить лайк ;)

[Srgwell 13]

11.04.2024 в 15:39, Maik812 сказал:

нажимаешь запись макрос и делаешь действия , после сохраняешь и делаешь кнопку на него ! делов то..

В результате хотелось получить так.

При запуске макроса после указания детали в дереве построения сборки выполняется команда- создать чертеж на эту деталь. То есть не надо открывать эту деталь отдельно и запускать- создать чертеж.

А если через начать запись макроса делать, то получается какая то ерунда, Все равно надо выходить в среду детали при записи, иначе ни как. И при этом имя файла детали всегда одно

[DmitriySD 26]

02.04.2024 в 09:35, Docuk1 сказал:

Доброго дня! Если Вы автор этого макроса, то не могли бы убрать показ сообщения о пустых строках (В таблице спецификации пропущены следующие позиции:) и выложить сюда. Спасибо!

Нет, я не автор, я только пользуюсь.

[kkk 280]

А нет ли в природе макроса, переименовывающем элементы в дереве проектирования по порядку, в соответствии с расположением в дереве? В смысле нагородили какую-то модель, элементы какие-то удаляли, какие-то перемещали в дереве, в итоге запустить макрос и иметь Эскиз 1 (2-3-4), Бобышка 1 (2-3-4) и т.д.

 

Не то, чтобы архиважная ситуация, но что-то подумалось. 

[Kelny 1 239]

3 минуты назад, kkk сказал:

В смысле нагородили какую-то модель, элементы какие-то удаляли, какие-то перемещали в дереве, в итоге запустить макрос и иметь Эскиз 1 (2-3-4), Бобышка 1 (2-3-4) и т.д.

Макрос не имеет ни какого смысла, т.к. некоторые эскизы прячутся в других элементах, но если очень хочется, то можете написать себе такой макрос который будет пробегаться по дереву и менять имена элементов дерева, в качестве примера можно взять макрос по переименовывания дерева в другой язык:

https://kelnyproject.ucoz.ru/load/renamed_features_in_featuremanager/7-1-0-21

 

 

[kkk 280]

9 минут назад, Kelny сказал:

т.к. некоторые эскизы прячутся в других элементах

А как это мешает эскизам называться по порядку? 

10 минут назад, Kelny сказал:

то можете написать себе такой макрос

Если бы мог, то скорее мое сообщение выглядело бы так: написал макрос, переименовывающий элементы в дереве... 

[Snake 60 689]

@kkk Так есть такой у Артема (см.через ВПН): https://www.codestack.net/solidworks-api/document/features-manager/rename-features-sequentially/

На всякий пожарный код с сайта:

Скрытый текст

 

'**********************
'Copyright(C) 2024 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/document/features-manager/rename-features-sequentially/
'License: https://www.codestack.net/license/
'**********************

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()

    Set swApp = Application.SldWorks
    
    Set swModel = swApp.ActiveDoc

try_:
    
    On Error GoTo catch_
    
    If Not swModel Is Nothing Then
        
        swModel.FeatureManager.EnableFeatureTree = False
        swModel.FeatureManager.EnableFeatureTreeWindow = False
        
        Dim vComps As Variant
        
        vComps = GetSelectedComponents(swModel.SelectionManager)
        
        If Not IsEmpty(vComps) Then
            
            Dim i As Integer
            
            For i = 0 To UBound(vComps)
                
                Dim swComp As SldWorks.Component2
                Set swComp = vComps(i)
                ProcessFeatureTree swComp.FirstFeature, swComp
                
            Next
        
        Else
            ProcessFeatureTree swModel.FirstFeature, swModel
        End If
        
    Else
        Err.Raise vbError, "", "Please open model"
    End If
    
    GoTo finally_
    
catch_:
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
finally_:
    
    If Not swModel Is Nothing Then
        swModel.FeatureManager.EnableFeatureTree = True
        swModel.FeatureManager.EnableFeatureTreeWindow = True
    End If

End Sub

Sub ProcessFeatureTree(firstFeat As SldWorks.Feature, owner As Object)
    
    Dim passedOrigin As Boolean
    passedOrigin = False

    Dim featNamesTable As Object
    Dim processedFeats() As SldWorks.Feature
    
    Set featNamesTable = CreateObject("Scripting.Dictionary")
        
    featNamesTable.CompareMode = vbTextCompare 'case insensitive
    
    Dim swFeat As SldWorks.Feature
    Set swFeat = firstFeat
    
    While Not swFeat Is Nothing
        
        If passedOrigin Then
        
            If Not Contains(processedFeats, swFeat) Then
                
                If (Not processedFeats) = -1 Then
                    ReDim processedFeats(0)
                Else
                    ReDim Preserve processedFeats(UBound(processedFeats) + 1)
                End If
                
                Set processedFeats(UBound(processedFeats)) = swFeat
        
                RenameFeature swFeat, featNamesTable, owner
            End If
            
            Dim swSubFeat As SldWorks.Feature
            Set swSubFeat = swFeat.GetFirstSubFeature
            
            While Not swSubFeat Is Nothing
                
                If Not Contains(processedFeats, swSubFeat) Then
                    If (Not processedFeats) = -1 Then
                        ReDim processedFeats(0)
                    Else
                        ReDim Preserve processedFeats(UBound(processedFeats) + 1)
                    End If
                    
                    Set processedFeats(UBound(processedFeats)) = swSubFeat
                    RenameFeature swSubFeat, featNamesTable, owner
                End If
                
                Set swSubFeat = swSubFeat.GetNextSubFeature
                
            Wend
        
        End If
        
        If swFeat.GetTypeName2() = "OriginProfileFeature" Then
            passedOrigin = True
        End If
        
        Set swFeat = swFeat.GetNextFeature
    Wend
    
End Sub

Sub RenameFeature(feat As SldWorks.Feature, featNamesTable As Object, owner As Object)

    If feat.GetTypeName2() <> "Reference" Then
    
        Dim baseFeatName As String
        
        If TryGetBaseName(feat.name, baseFeatName) Then
            
            Dim nextIndex As Integer
                
            If featNamesTable.Exists(baseFeatName) Then
                nextIndex = featNamesTable.item(baseFeatName) + 1
                featNamesTable.item(baseFeatName) = nextIndex
            Else
                nextIndex = 1
                featNamesTable.Add baseFeatName, nextIndex
            End If
            
            Dim newName As String
            newName = baseFeatName & nextIndex
            
            If LCase(feat.name) <> LCase(newName) Then
            
                ResolveFeatureNameConflict owner, newName
            
                feat.name = newName
            
            End If
            
        End If
        
    End If

End Sub

Function TryGetBaseName(name As String, ByRef baseName As String)
    
    TryGetBaseName = False
    baseName = ""
    
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.Pattern = "(.+?)(\d+)$"
    
    Dim regExMatches As Object
    Set regExMatches = regEx.Execute(name)
    
    If regExMatches.Count = 1 Then
        
        If regExMatches(0).SubMatches.Count = 2 Then
            
            baseName = regExMatches(0).SubMatches(0)
            TryGetBaseName = True
            
        End If
        
    End If
    
End Function

Sub ResolveFeatureNameConflict(owner As Object, name As String)
    
    Const INDEX_OFFSET As Integer = 100
    Dim index As Integer
    
    Dim swFeatMgr As SldWorks.FeatureManager
    
    Dim swFeat As SldWorks.Feature
        
    If TypeOf owner Is SldWorks.Component2 Then
        
        Dim swComp As SldWorks.Component2
        Set swComp = owner
        
        Dim swRefModel As SldWorks.ModelDoc2
        Set swRefModel = swComp.GetModelDoc2
        
        If Not swRefModel Is Nothing Then
            Set swFeatMgr = swRefModel.FeatureManager
            Set swFeat = swComp.FeatureByName(name)
        Else
            Err.Raise vbError, "", "Component model is not loaded"
        End If
        
    ElseIf TypeOf owner Is SldWorks.ModelDoc2 Then
        
        Dim swModel As SldWorks.ModelDoc2
        Set swModel = owner
        Set swFeatMgr = swModel.FeatureManager
        Set swFeat = swModel.FeatureByName(name)
        
    Else
        Err.Raise vbError, "", "Not supported owner"
    End If
    
    If Not swFeat Is Nothing Then
        
        Dim baseName As String
        
        If TryGetBaseName(name, baseName) Then
            
            Dim newName As String
            newName = baseName & (INDEX_OFFSET + index)
            
            While False <> swFeatMgr.IsNameUsed(swNameType_e.swFeatureName, newName)
                index = index + 1
                newName = baseName & (INDEX_OFFSET + index)
            Wend
            
            swFeat.name = newName
            
        Else
            Exit Sub
        End If
    
    End If
    
End Sub

Function Contains(vArr As Variant, item As Object) As Boolean
    
    Dim i As Integer
    
    For i = 0 To UBound(vArr)
        If vArr(i) Is item Then
            Contains = True
            Exit Function
        End If
    Next
    
    Contains = False
    
End Function

Function GetSelectedComponents(selMgr As SldWorks.SelectionMgr) As Variant

    Dim isInit As Boolean
    isInit = False
    
    Dim swComps() As SldWorks.Component2

    Dim i As Integer
    
    For i = 1 To selMgr.GetSelectedObjectCount2(-1)
                
        Dim swComp As SldWorks.Component2
    
        Set swComp = selMgr.GetSelectedObjectsComponent4(i, -1)
        
        If Not swComp Is Nothing Then
            
            If Not isInit Then
                ReDim swComps(0)
                Set swComps(0) = swComp
                isInit = True
            Else
                If Not Contains(swComps, swComp) Then
                    ReDim Preserve swComps(UBound(swComps) + 1)
                    Set swComps(UBound(swComps)) = swComp
                End If
            End If
                        
        End If
    
    Next

    If isInit Then
        GetSelectedComponents = swComps
    Else
        GetSelectedComponents = Empty
    End If

End Function

 

Изменено 17 апреля пользователем Snake 60

[kkk 280]

5 часов назад, Snake 60 сказал:

Так есть такой

Вот прям то, что нужно! Особенно приятно, что переименовывает только стандартные названия элементов, если сам переименовал элемент во что-то свое, то такие не трогает.

[Srgwell 13]

Есть такая штуковина в эскизах соливеркса. В эскизах если отрезки темные они определены. Было бы здорово, если в сборке деталей детали которые подвижные, то есть у которых не хватает сопряжений, обозначались другим цветом.

У меня, например вчера большая сборка из-за каких то движений не сопряженных деталей так перевернулась!!! Я долго искал детали, которые подвижные. Конечно я перевертыш вернул назад, но причину искал долго.

Изменено 18 апреля пользователем Srgwell

[Павлуха 506]

34 минуты назад, Srgwell сказал:

Есть такая штуковина в эскизах соливеркса. В эскизах если отрезки темные они определены. Было бы здорово, если в сборке деталей детали которые подвижные, то есть у которых не хватает сопряжений, обозначались другим цветом.

У меня, например вчера большая сборка из-за каких то движений не сопряженных деталей так перевернулась!!! Я долго искал детали, которые подвижные. Конечно я перевертыш вернул назад, но причину искал долго.

 

Недоопределённые детали видно.

Читайте справку.

[Snake 60 689]

55 минут назад, Srgwell сказал:

Было бы здорово, если в сборке деталей детали которые подвижные, то есть у которых не хватает сопряжений, обозначались другим цветом.

Так они и так выделяются в дереве вот таким знаком (-) перед именем детали/сборки

[kkk 280]

1 час назад, Srgwell сказал:

Есть такая штуковина в эскизах соливеркса. В эскизах если отрезки темные они определены.

По самому вопросу уже ответили, но если чуть отойти в сторону, то достаточно соблюдать одно нехитрое правило - ВСЕГДА  полностью определять эскизы (кроме случаев, когда Вы точно знаете, что можно оставить недоопределенным, но это, пока, не Ваш случай).

[Srgwell 13]

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

Так они и так выделяются в дереве вот таким знаком (-) перед именем детали/сборки

век живи- век учись

[nahaus 9]

Подскажите пожалуйста как редактировать цвет и толщину таблицы параметров (вставка - таблицы - таблица параметров) детали на чертеже?

Так выглядит таблица сейчас.

Ее можно отредактировать в модели, но это очень не удобно.

Может есть макрос для удобного редактирования или создания таблиц. SW 2014.

Изменено 18 апреля пользователем nahaus

[Srgwell 13]

22.04.2022 в 11:51, tompsongun сказал:

С позволения уважаемого @alek77  внёс небольшое изменение в его макрос по подсчёту компонентов - добавил кнопку "выбрать все", может пригодится для наглядности, массовой замены/удаления, особенно где много одинаковых элементов (например в пневматике/электрике). после закрытия макроса выделение сохраняется.

 

 

ComponentInfo (mod1 tompsongun).swp 156 \u041a\u0431 · 41 скачивание

А нельзя ли как нибудь совместить этот макрос с волшебным макросом part_counter для внесении количества в свойство. Просто второй считает с ограничениями и с ошибкой, а первый считает идеально. Количество деталей в чертеж- это супер

Изменено 19 апреля пользователем Srgwell

[Snake 60 689]

@Srgwell  У меня это уже сделано:

Как раз на основе макроса от Алек77: https://snake-60.ru/blog/blog-list/84-onepage-blog/78-fromfilenametoproperties-vba-makros-paketnogo-zaneseniya-svojstv-v-detali-i-ili-podsborki

[malvi.dp 266]

18.04.2024 в 12:45, nahaus сказал:

Подскажите пожалуйста как редактировать цвет и толщину таблицы параметров (вставка - таблицы - таблица параметров) детали на чертеже?

Визуальное отображение таблицы параметров (ТП) на чертеже зависит от того как она была сохранена в модели (ПКМ в дереве на ТП - Редактировать таблицу). Именно в окне модели солида!

Скрытый текст

 

Так будет выглядеть на чертеже

Скрытый текст

Ещё таблицу можно открыть в отдельном окне Эксель. Можно сохранить как отдельный файл Эксель, сделать в нем все необходимое форматирование и выбрать "из файла" , при создании ТП. При этом все-равно нужно ее визуально "поправить" в окне модели солида, чтобы она корректно отобразилась на чертеже.

Если же при вставке на чертеже ТП отображается неправильно, лучше ее удалить с чертежа, "поправить" в модели и снова вставить на чертеж.

18.04.2024 в 12:45, nahaus сказал:

Может есть макрос для удобного редактирования или создания таблиц. SW 2014.

Макрос не встречал.