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

[Snake 60 669]

@Kir95 Мне понравилось как подсчет компонентов реализовал Alek77 в его макросе ComponentInfo. Он использовал Коллекцию (Collection) для подсчета, без траверсинга всего дерева. Макрос здесь выкладывался, можно поискать...

[Kir95 950]

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

понравилось как подсчет компонентов реализовал Alek77 в его макросе ComponentInfo. Он использовал Коллекцию (Collection) для подсчета, без траверсинга всего дерева. Макрос здесь выкладывался, можно поискать

Пропустил как-то ( Классный макрос

[Kelny 1 229]

14 часов назад, Kir95 сказал:

Макрос - подсчитывает и показывает общее количество

А разве тоже самое не делает штатный инструмент ВИЗУАЛИЗАЦИЯ СБОРКИ? При выборе компонента подсвечивает его в списке.

http://help.solidworks.com/2010/russian/solidworks/sldworks/allcontent/solidworks/core/assemblies/hidd_visualization_tool_help.htm

[Kir95 950]

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

А разве тоже самое не делает штатный инструмент ВИЗУАЛИЗАЦИЯ СБОРКИ?

Почти - у визуализации своё дерево, своя группировка/сортировка деталь ещё поискать нужно, а здесь в днреве ткнул в деталь, нажал кнопку - появилось общее к-во.

Но у Алек77 макро ComponentInfo классный - вся инфа по компоненту показывается

 

Вот нарыл в закромах макрос - считает к-во "исключённых из спецификации" компонентов, записывает названия в текстовый файл, сохраняет и открывает этот файл в виндосовском блокноте. Кому интересно, заодно можно посмотреть в коде, как скидывается информация в текстовый файл и запускается блокнот.

Макрос GetListExcludeFromBOM

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

Dim swApp As SldWorks.SldWorks
Dim Assembly As ModelDoc2
Dim myAsy As AssemblyDoc
Dim myCmps
Dim i As Long
Dim myCmp As Component2
Dim CmpDoc As ModelDoc2
Dim fso As Object
Dim FileList As Object
Dim myCmpName As String
Dim Cfg As String

Sub main()

Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly
Set fso = CreateObject("Scripting.FileSystemObject")
'
Set FileList = fso.CreateTextFile("C:\temp\List.txt", 8, -2)
    
myCmps = myAsy.GetComponents(False)

For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)

Set CmpDoc = myCmp.GetModelDoc
Cfg = myCmp.ReferencedConfiguration

     myCmpName = myCmp.Name2
'     Debug.Print myCmpName
     myCmpName = Mid$(myCmpName, InStrRev(myCmpName, "/") + 1)

If myCmp.ExcludeFromBOM Then
FileList.Write myCmpName & " (" & Cfg & ") " & vbCrLf 'myCmp.Name2
'Debug.Print myCmp.Name2 & " (" & Cfg & ") "
End If
Next i

FileList.Close

Shell "notepad.exe ""C:\temp\List.txt""", vbNormalFocus

End Sub

 

В инструментах предварительно подключить библиотеку microsoft scriptlet library - на картинке внизу

 

[Kelny 1 229]

17.01.2019 в 11:43, alek77 сказал:

Макрос ComponentInfo для вывода информации выбранного компонента сборки на экран (sw17sp5)

...

Обновил внешний вид, а то форма была перегружена информацией слегка.

Прошу потестировать

ComponentInfo.bmp

ComponentInfo.swp

Если заменить .Get4 на .Get3, а так же заменить ссылки на библиотеки на установленную версию (меню Tools-References... заменить строки с ошибкой Missing!...), то работает с версии SW2008 sp4.

Изменено 27 апреля 2021 пользователем Kelny

[tompsongun 449]

SaveAsCopyReplace 3.0

- добавил контекстные меню для текстовых полей: копировать, вставить, ...

SaveAsCopyReplace 3.0.zip

[tompsongun 449]

код контекстного меню на userform. искал долго, чтоб просто и понятно, исходник правда подразбил как мне надо, чтобы поменьше места занимало. используется системная библа user32

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

'модуль фомы
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As Long
Private Declare PtrSafe Function TrackPopupMenuEx Lib "user32"   (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, _
ByVal hWnd As Long, ByVal lptpm As Any) As Long
Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA"   (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, _
 ByVal lpNewItem As Any) As Long
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA"    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

 

Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&

Public hMenu As Long
Public hWnd As Long
Public ИмяТекстПоля As String
Public ТекстБуфера As String
 

Private Sub UserForm_Initialize()
hWnd = FindWindow(vbNullString, Me.Caption)

...

End Sub

Private Sub КонтекстМеню(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)     'формирование меню и выбора
Dim Pt As POINTAPI
Dim ret As Long
    If Button = 2 Then
        hMenu = CreatePopupMenu()
        AppendMenu hMenu, MF_STRING, 1, "Копировать"
        AppendMenu hMenu, MF_STRING, 2, "Вставить"
        AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
        AppendMenu hMenu, MF_STRING, 4, "Вырезать"
        AppendMenu hMenu, MF_SEPARATOR, 5, ByVal 0&
        AppendMenu hMenu, MF_STRING, 6, "Очистить"
        GetCursorPos Pt
        ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or _
                               TPM_RIGHTBUTTON, Pt.X, Pt.Y, hWnd, ByVal 0&)
        DestroyMenu hMenu
            Select Case ret
                Case 1
                Call Копировать
                Case 2
                Call Вставить
                Case 4
                Call Вырезать
                Case 6
                Call Очистить
            End Select
    End If
End Sub

 

'---------------------------------------- КОМАНДЫ КОНТЕКСТА----------------------------
Private Sub Копировать()
   ТекстБуфера = Me.Controls(ИмяТекстПоля).SelText
  SetClipboardText ТекстБуфера
End Sub

 

Private Sub Вставить()
ТекстБуфера = ClipboardText
Me.Controls(ИмяТекстПоля).SelText = ТекстБуфера
End Sub

 

Private Sub Вырезать()
ТекстБуфера = ComboBox1.SelText
  SetClipboardText ТекстБуфера
Me.Controls(ИмяТекстПоля).SelText = ""
End Sub

 

Private Sub Очистить()
Me.Controls(ИмяТекстПоля).Value = ""
End Sub

 

Function ClipboardText() ' чтение
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        ClipboardText = .GetText
    End With
End Function
 
Sub SetClipboardText(ByVal ТекстБуфера) ' запись
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText ТекстБуфера
        .PutInClipboard
    End With
End Sub

'---------------------------------------------------------------- применение ---------

 

Private Sub тНовыйПуть_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)    'текстовое поле/комбобокс
ИмяТекстПоля = тНовыйПуть.Name
Call КонтекстМеню(Button, Shift, X, Y)
End Sub

 

Private Sub тНовоеИмя_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)    'текстовое поле/комбобокс
ИмяТекстПоля = тНовоеИмя.Name
Call КонтекстМеню(Button, Shift, X, Y)
End Sub

 

Private Sub тИсходныйПуть_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)    'текстовое поле/комбобокс с подсказкой в статусную на форме
Const lngSensitivity As Long = 5
ИмяТекстПоля = тИсходныйПуть.Name
Call КонтекстМенюТолькоКопировать(Button, Shift, X, Y)
   With тИзСборки
        If (X > lngSensitivity And X < .Width - lngSensitivity And Y > lngSensitivity And Y < .Height - lngSensitivity) Then
            мПодсказки.Caption = "Текущая модель для копирования открыта из указанной в этом поле сборки."
            Else
            мПодсказки.Caption = ""
        End If
   End With
End Sub

 

[Kelny 1 229]

59 минут назад, tompsongun сказал:

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As Long

Могу ошибаться, т.к. глубоко не копал на этот счёт, но для ...PtrSafe... вроде правильнее As LongPtr

https://docs.microsoft.com/ru-ru/office/vba/language/reference/user-interface-help/longptr-data-type

 

А что бы код был универсальным можно записать так:

Цитата

#If VBA7 Then    '  Office 2010-2013 'x64-bit
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
...
#Else    '  Office 2003-2007 'x32-bit
Private Declare Function CreatePopupMenu Lib "user32" () As Long

...
#End If

 

[tompsongun 449]

 

@Kelny , спасибо, за подсказку!. и Вы правы LongPtr - это более верная запись. просто я не особо парился ибо не дыбаю особо-то. )) смотрю и так проканало только с PtrSafe. и пока оставил. ))

в дальнейшем поправлю, конечно же с остальными ошибками, чтобы кошерно-халяльно было и подводных камней избежать.

 

вот только без ptrsafe вариант с else не проходит - высвечивает ошибку и макрос не идёт далее. ((

наверно, можно, что-то отключить в отладчике, но смогу ли я быть уверенным, что не будут пропущенны иные ошибки?

 

может можно "приаттачить" эту библиотеку вместе с макросом, чтобы он был рядышком, и shell32 тоже (и он задействован)

 

Изменено 27 апреля 2021 пользователем tompsongun

[tompsongun 449]

почему-то функции FindWindow не проходит LongPtr, а просто Long проходит. может то что за внешниими скобками оставлять Long, а внутренние переменные LongPTR ?

и припомнилось, что с этими ПТР как-то парился, наверно, поэтому в этот раз и оставил "лонги" без оных

Изменено 27 апреля 2021 пользователем tompsongun

[streamdown 1 565]

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

не проходит LongPtr, а просто Long проходит.

Какая у вас битность Windows?

https://codekabinett.com/download/win32api-data-types-vba.pdf

 

https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit

[tompsongun 449]

@streamdown , спасибо! ну раз солид 2020 - 64битная, и что ptr использую.  код работает (интуитивно угадал оставив лонги без ptr),

просто интересно стало обязательно ли лонги пэтээрить.

 везде ли его надо использовать. пролистав Вашу ссылку увидел, что не везде - учить матчасть или как я наугад )) не работает - добавим, а тут? убавим,  эгегей ))

например, увидел, что какие-то переменные и так и эдак хорошо заходят ))

ну, тогда оставлю пока как есть, и, если ошибки вдруг , у кого на это появятся - поправлю. а вот как @Kelny , предлагал - универсализировать бы ...

 

Изменено 27 апреля 2021 пользователем tompsongun

[Kelny 1 229]

3 часа назад, tompsongun сказал:

код контекстного меню на userform. искал долго, чтоб просто и понятно

Можно сообразить контекстное меню средствами VBA с помощью Frame, без внешних библиотек, см.приложение

PopUpMenu_VBA.zip

 

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

может можно "приаттачить" эту библиотеку вместе с макросом, чтобы он был рядышком, и shell32 тоже (и он задействован)

Вроде относительно стандартная.

 

13 минут назад, tompsongun сказал:

ну раз солид 2020 - 64битная, и что ptr использую.  код работает

Так понимаю там всё же зависимость от МСОфиса ведь можно сделать универсальный код:

Цитата

#If VBA7 Then    '  Office 2010-2013 'x64-bit
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
...
#Else    '  Office 2003-2007 'x32-bit
Private Declare Function CreatePopupMenu Lib "user32" () As Long

...
#End If

 

Изменено 27 апреля 2021 пользователем Kelny

[tompsongun 449]

@Kelny , спасибо болущее, обязательно посмотрю - хотелось бы да, без внешних библиотек реализовать.

 

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

#If VBA7 Then    '  Office 2010-2013 'x64-bit
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
...
#Else    '  Office 2003-2007 'x32-bit
Private Declare Function CreatePopupMenu Lib "user32" () As Long

...
#End If

 

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

вот только без ptrsafe вариант с else не проходит - высвечивает ошибку и макрос не идёт далее. ((

наверно, можно, что-то отключить в отладчике, но смогу ли я быть уверенным, что не будут пропущенны иные ошибки?

 

но раз без внешних библиотек смогу с Вашей подсказкой реализовать - тогда это не актуально, наверно, но интересно таки.

[streamdown 1 565]

40 минут назад, tompsongun сказал:

без внешних библиотек

user32 это не внешняя библиотека, это API винды. Да вы по сути всем кодом только и делаете, что используете библиотеки (References). 

Опасаться каких либо косяков надо тогда, когда сторонние библиотеки в стадии развития, или обновления.

К примеру, для Excel какого-нибудь давно сделал свой класс заглушку, которому вообще плевать какая версия Excel стоит. И класс не использует библиотеки от Office. Всё через Reflection - а это уже штатный функционал .NET

Изменено 27 апреля 2021 пользователем streamdown

[Kelny 1 229]

6 часов назад, tompsongun сказал:

почему-то функции FindWindow не проходит LongPtr, а просто Long проходит. может то что за внешниими скобками оставлять Long, а внутренние переменные LongPTR ?

Подходит, но при инициализации формы LongPtr пихается в Long и оно туда не лезет:

Цитата

...

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr

...

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA"    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

...

Public hMenu As Long

Public hWnd As Long
...
 

Private Sub UserForm_Initialize()
hWnd = FindWindow(vbNullString, Me.Caption)

...

End Sub

Так что надо объявление данных переменных так же сунуть в выбор системы:

Цитата

#If VBA7 Then    '  Office 2010-2013 'x64-bit

Public hWnd As LongPtr, hMenu As LongPtr
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
...
#Else    '  Office 2003-2007 'x32-bit

Public hWnd As Long, hMenu As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long

...
#End If

 

Изменено 27 апреля 2021 пользователем Kelny

[Kelny 1 229]

 

7 часов назад, tompsongun сказал:

вот только без ptrsafe вариант с else не проходит - высвечивает ошибку и макрос не идёт далее. ((

наверно, можно, что-то отключить в отладчике, но смогу ли я быть уверенным, что не будут пропущенны иные ошибки?

По этому описанию сложно что-то сказать (самого кода и ошибки не видно, что бы посмотреть), может действительно есть ошибка потому и не идёт. По #Else вполне работает (в системе нет VBA7), при этом то что #If VBA7 Then подсвечено красным, но ни каких проблем нет при запуске макроса (берётся только то что после #Else, а выше красное игнорируется).

Изменено 27 апреля 2021 пользователем Kelny

[tompsongun 449]

SaveAsCopyReplace 3.0.1

- Дополнительные настройки: Читать информацию в поля основной надписи макроса Только с Активной конфигурации - включить, если Вы не пользуетесь Полями основной надписи, ускорит работу макроса за счёт не считывания полей остальных конфигураций.

(файл настройки пересоздастся, т.к. новое значение чек-бокса надо записать)

 

SaveAsCopyReplace.swp

[tompsongun 449]

SaveAsCopyReplace

Тут проблемы обнаружил - регресс -в копию модели записывается старое обозначение в конфигурацию. и Наименование_ФБ не считывает. буду решать. но скорее всего на выходных. прошу извинить. с массивами и условиями надо попарится.

 

свойства после переименования пока править через МПроп надоть.

Изменено 29 апреля 2021 пользователем tompsongun

[malvi.dp 261]

Прошу помощи знатоков VBA 

Есть файл xls-dbf.xls с макросом в excel 2003 - он формирует определенный отчет из сохраненной спецификации солида в последующую программу в формате *.dbf

C помощью команды 

Shell ("C:\Program Files (x86)\Microsoft Office\Office2003\EXCEL.EXE ")  запускаю excel 2003.

А вот как открыть файл  C:\TCS\xls-dbf.xls  и в нем запустить макрос не пойму.

Хочу повесить на кнопку в SW и запускать прямо из солида.

Изменено 29 апреля 2021 пользователем malvi.dp