Перейти к публикации

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


Рекомендованные сообщения

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

Ссылка на сообщение
Поделиться на других сайтах


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

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

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

Ссылка на сообщение
Поделиться на других сайтах
14 часов назад, Kir95 сказал:

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

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

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

Ссылка на сообщение
Поделиться на других сайтах
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 - на картинке внизу

reference microsoft scrip library.jpg

 

Ссылка на сообщение
Поделиться на других сайтах
17.01.2019 в 11:43, alek77 сказал:

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

...

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

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

ComponentInfo.bmp

ComponentInfo.swp

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

Изменено пользователем Kelny
Ссылка на сообщение
Поделиться на других сайтах

SaveAsCopyReplace 3.0

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

SaveAsCopyReplace 3.0.zip

Ссылка на сообщение
Поделиться на других сайтах

код контекстного меню на 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

 

Ссылка на сообщение
Поделиться на других сайтах
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

 

Ссылка на сообщение
Поделиться на других сайтах

 

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

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

 

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

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

 

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

 

Изменено пользователем tompsongun
Ссылка на сообщение
Поделиться на других сайтах

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

изображение.png

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

Изменено пользователем tompsongun
Ссылка на сообщение
Поделиться на других сайтах
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

Ссылка на сообщение
Поделиться на других сайтах

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

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

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

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

изображение.png

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

 

Изменено пользователем tompsongun
Ссылка на сообщение
Поделиться на других сайтах
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

 

Изменено пользователем Kelny
Ссылка на сообщение
Поделиться на других сайтах

@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 не проходит - высвечивает ошибку и макрос не идёт далее. ((

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

 

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

Ссылка на сообщение
Поделиться на других сайтах
40 минут назад, tompsongun сказал:

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

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

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

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

Изменено пользователем streamdown
Ссылка на сообщение
Поделиться на других сайтах
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 LongPtrhMenu As LongPtr
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
...
#Else    '  Office 2003-2007 'x32-bit

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

...
#End If

 

Изменено пользователем Kelny
Ссылка на сообщение
Поделиться на других сайтах

 

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

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

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

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

Изменено пользователем Kelny
Ссылка на сообщение
Поделиться на других сайтах

SaveAsCopyReplace 3.0.1

изображение.png

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

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

 

SaveAsCopyReplace.swp

Ссылка на сообщение
Поделиться на других сайтах

SaveAsCopyReplace

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

 

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

Изменено пользователем tompsongun
Ссылка на сообщение
Поделиться на других сайтах

Прошу помощи знатоков 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 и запускать прямо из солида.

Изменено пользователем malvi.dp
Ссылка на сообщение
Поделиться на других сайтах

Присоединяйтесь к обсуждению

Вы можете опубликовать сообщение сейчас, а зарегистрироваться позже. Если у вас есть аккаунт, войдите в него для написания от своего имени.
Примечание: вашему сообщению потребуется утверждение модератора, прежде чем оно станет доступным.

Гость
Ответить в тему...

×   Вставлено в виде отформатированного текста.   Вставить в виде обычного текста

  Разрешено не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отобразить как ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставить изображения напрямую. Загрузите или вставьте изображения по ссылке.

  • Сейчас на странице   0 пользователей

    Нет пользователей, просматривающих эту страницу.




  • Сообщения

    • Stanislav
      Относительно POP and PUP в фале постпроцессора вот такое нашел для POP прослеживается возростающая закономерность, а вот для  PUP не ясно почему прыгает значение. # POP and PUP functions for initialization. H parameters are used to  # # get the correct POP and PUP values. If the thickness of the sheet   # # is between the minimum and maximum thickness, the postprocessor     # # will use POP and PUP parameters to write them in the PS file.       # # Example: H000 0.0 1.0 30000 25000                                   # #                                                                     # #     Minimum      Maximum       POP        PUP                       # #    Thickness    Thickness     Value      Value                      # #---------------------------------------------------------------------# H001    0.0          0.5        14000      9000 H002    0.51         1.0        14500      9000 H003    1.01         1.5        15000      9000 H004    1.51         2.0        15500      9000 H005    2.01         2.5        16000      8500 H006    2.51         3.0        16500      8000 H007    3.01         3.5        17000      8000 H008    3.51         4.0        17500      8000 H009    4.01         4.5        18000      9000 H010    4.51         5.0        18500      8000 H011    5.01         5.5        19000      9000 H012    5.51         6.0        19500      8000
    • Krusnik
      Да там же ничего сложного.   Делаете вашу спираль.   Потом делаете эскиз. В эскизе нажимаете Преобразование объектов и тыкаете на созданную спираль.   Нажимаете поверхность вытянуть и выбираете только что созданный эскиз. В опциях вытягивание ставите "До поверхности". И вытягиваете спиральку до вашего купола.   И последний шаг - вырез по траектории. Думаю с этим вы без моих советов справитесь.   Лишнее скрываете и вуаля.  
    • IgP
      Это, конечно, да, не хорошо ... Но и конструктор не бог чтобы всё знать ... Для этого есть и д.б. этап "технологическая проработка", со всеми вытекающими.
    • arsenev
      Спасибо за ответ. Нет, в видео он говорит, что это такая стратегия. Пробовал использовать шаблон и обрабатывать его со смещением, получается не то (именно, когда нужно обработать цилиндрическое отверстие). Лучше отводится стружка и не мешает резанию. (см. видео, где-то с 18 минуты).
    • scrimline
      Если ещё нужна информация, fanuc oi-tf станок akira-seiki, М14 на опускание руки, для привязки и М15 для поднятия
    • Богоманшин Игорь
      Эта проблема от незнания некоторыми конструкторами технологических особенностей порошковой окраски. Максимум на чертеже научатся указывать РАЛ и толщину слоя. А необходимо предусмотреть места подвеса, можно туда шпильки или гайки запрессовать в нужных местах.
    • MagicNight
      Добрый день! Обратил внимание, что стал шуметь (свистеть) шпиндель станка, причём на всех режимах. Я так понимаю, что полетели подшипники. Хотим найти их, но не знаем как они называются, может у кого-то было подобное? Ну и отремонтировать своими силами. Станок швейцарский Mikron UCP-710 пятиосевой.  
    • maxx2000
      это не одно и тоже что и создать шаблон? А если мне нужен будет документ без зон?
    • IgorT
      Может быть уточнить надо?  Достаточно в шаблоне, который используется для создания чертежа, включить эти самые зоны.
    • ak762
×
×
  • Создать...