Jump to content

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


Recommended Posts

Maik812
13.04.2021 в 12:57, Вадим Митрофанович сказал:

Переименовал копию и подставил чертеж. Через полгода плюнул.

Искать то, что нужно медленнее, чем сделать заново деталь.

Вот именно, что найти дольше если не делать все правильно, просто фаил и чертеж. не чего не даст !

Link to post
Share on other sites


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

Расписывать дольше, чем сохранять )

Идея понятна, спасибо!

Link to post
Share on other sites
tompsongun

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

SaveAsCopyReplace 2.9

что изменилось(включая промежуточную версию 2.8.1 :

-  исправил. свойство примечания вносилось в раздел и поле утвердил,

- добавил кнопка очистки дополнительных полей,

-  исправленно зацикливание при удалении исходного чертежа,

- исправление фантомных свойств клона в исходной модели,

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

- независимость внесения  дополнительных полей основной надписи от вносимости обозначения и наименования,

- обработка имён и разделов по внесению наименования,

- считывание основных свойств из всех конфигов и создание для них вкладок полей,

- изменение считаных свойств и внесение их в копию,

- перекомпоновка интерфейса

- системы подсказок в статусной строке макроса

- возможность сохранения изменений основных свойств со вкладок полей конфигураций в исходной модели - кнопка вИМ,

- проверка выбора разнотипных моделей,

- проверка выбора одноименных моделей (вернее сравнение их полных путей)

- возможность замены нескольких моделей за 1 раз при предвыборе и не только одноименных,

- удаление исходных (копируемых) чертежа и модели в корзину - при выборе нескольких разноимённых компонентов, будет удалены только та модель и чертёж, которые были определены как исходные, т.е. та модель с которой работали (клонировали).

- дополнил справку.

 

SaveAsCopyReplace 2.9.zip

 

Screenshot_2.jpg

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

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

 

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

 

  • Нравится 2
  • Чемпион 2
Link to post
Share on other sites
tompsongun

эх, ну почему так.. как поделишься, так находишь косяки. (((

2.9.1 исправил один оператор - случайно стёр часть имени - соотв. некоторое в коде просто не работало

 

работаю над : добавление имени конфигурации к обозначению проходиn только для одной конфы

 

тут не знаю как лучше, думал дать пользователю возможность обозначить иначе

 

думаю, над логикой ещё предстоит покумекать... и видимо стоит приоритет Блока2 сделать выше, чем на вкладках!

 

SaveAsCopyReplace 2.9.1.zip

 

Edited by tompsongun
Link to post
Share on other sites
none
1 час назад, tompsongun сказал:

эх, ну почему так.. как поделишься, так находишь косяки. (((

2.9.1 исправил один оператор - случайно стёр часть имени - соотв. некоторое в коде просто не работало

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

 

думаю, над логикой ещё предстоит покумекать...

SaveAsCopyReplace 2.9.1.zip 151 \u041a\u0431 · 0 скачиваний

 

Словил момент: если работать с подсборкой из сборки (выбрать в дереве подсборку и нажать кнопку макроса) происходит открытие подсборки в отдельном окне, но само окно макроса не появляется. Тестировал на одноуровневой сборке, - работает нормально.  Продолжу тестирование. А можно было бы вообще не открывать ту сборку или деталь с которой будет работать макрос? просто вывести вопрос: Работаем с такой-то сборкой/деталью?, если да, то грузить окно макроса и все сразу.

  • Нравится 1
Link to post
Share on other sites
tompsongun

спасибо, посмотрю.

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

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

пока отладим основное.

 

вот, для теста - поменял приоритет Блока2 пока.

SaveAsCopyReplace 2.9.2.zip

 

и тут случайно столкнулся с тем, что макрос тоже себя никак не проявляет визуально, если работаешь с оделью, в которой активная конфигурация имеет имя, например, 001, 0005.  это прям сюрприз. конфиг 00 - нормально же отрабатывает.

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

 

  • Нравится 2
  • Чемпион 1
Link to post
Share on other sites
none
18 минут назад, tompsongun сказал:

спасибо, посмотрю.

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

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

пока отладим основное.

 

вот, для теста - поменял приоритет Блока2 пока.

SaveAsCopyReplace 2.9.2.zip 195 \u041a\u0431 · 0 скачиваний

 

и тут случайно столкнулся с тем, что макрос тоже себя никак не проявляет визуально, если работаешь с оделью, в которой активная конфигурация имеет имя, например, 001, 0005.  это прям сюрприз. конфиг 00 - нормально же отрабатывает.

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

 

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

  • Печаль 1
Link to post
Share on other sites
tompsongun

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

Link to post
Share on other sites
tompsongun

GetSelectedObjectsComponent - возможно из-за них читаю что 2и 3 - устаревшие, делаю как в формате 4  - тишина. оконце не появляется. вот видимо оно и создает проблемы, но блин, почему устаревший формат у меня работает? )) ладно буду пилить, не буду сорить ))

может из библ чего не подключено, понятно что на 2020 не смотрим ))

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

Edited by tompsongun
Link to post
Share on other sites
none
5 часов назад, tompsongun сказал:

GetSelectedObjectsComponent - возможно из-за них читаю что 2и 3 - устаревшие, делаю как в формате 4  - тишина. оконце не появляется. вот видимо оно и создает проблемы, но блин, почему устаревший формат у меня работает? )) ладно буду пилить, не буду сорить ))

может из библ чего не подключено, понятно что на 2020 не смотрим ))

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

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

  • Нравится 1
Link to post
Share on other sites
Kir95
19 часов назад, tompsongun сказал:

GetSelectedObjectsComponent - возможно из-за них читаю что 2и 3 - устаревшие, делаю как в формате 4  - тишина. оконце не появляется. вот видимо оно и создает проблемы, но блин, почему устаревший формат у меня работает?

 

Так устаревший будет в новом солиде работать, а новый апи код в старом солиде - нет. Если выделить кусок кода и нажать ф1, появится окно справки, в самом низу пишется, с какого года этот код используется. На картинке внизу справка по Save3 - с 2001 года работает
 

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

справка api.JPG

 

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

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

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

Наверное, лучше отдельную тему для этого макроса сделать, чтобы сообщения о доработках/изменениях не затирались

 

Макрос - открывает окно свойств выбранного в дереве сборки компонента (на любом уровне вложенности). Можно переключаться по вкладкам "Суммарная информация", "Настройки", "Конфигурация", вносить изменения, копировать записи, при этом не переходя в файл самой детали/подсборки

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

Option Explicit
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swSelMgr            As SldWorks.SelectionMgr
    Dim swComp              As SldWorks.Component2
    Dim swRefDoc            As SldWorks.ModelDoc2
Sub main()
On Error GoTo swMsg
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swComp = swSelMgr.GetSelectedObject6(1, -1)
    Set swRefDoc = swComp.GetModelDoc2
    swRefDoc.FileSummaryInfo
    swModel.ClearSelection2 True
    Exit Sub
swMsg:
MsgBox "Выберите компонент в дереве сборки и запустите макрос"
End Sub

 

  • Нравится 5
  • Чемпион 1
Link to post
Share on other sites
DuS
12.04.2021 в 17:29, tompsongun сказал:

@DuS , прям, вот с языка сняли по библиотеке типовых чертежей ))

начинал как-то делать, но потом решил saveAsCopy допилить, т.к. им и хотел наполнять библиотеку.

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

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

...

многое порешать, правда в них бы надо было подразобраться ))

 

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

  • Нравится 1
Link to post
Share on other sites
tompsongun

Рад, что Вам подошло!

 

очередной пробничек saveAsCopyReplace 2.9.3

 

исправил регресс - по длине 1 строки наименования,

поправил логику считывание и внос свойства Разработал в общ. вкладку и в конфиги (в полной мере не тестил) и отображение во вкладках макроса,
упорядочивание кода - подразбил на подпрограммы, нашёл лишнее ))

изменил считывание и запись в списки файлов настроек

кнопка вызова окна свойств solidworks текущей модели (подсказка от Kir95 - мне понравилось )) и потестировать удобнее стало, не закрывая макрос пока отлажывал откуда конструктора хавать или нет) - только она сбрасывает вкладки в макросе, но в ней можно поправить и вкладки в макросе пересоздадутся/обновятся

 

надеюсь по стабильнее стала

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

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

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

 

SaveAsCopyReplace 2.9.3.zip

 

@DuS , очень рад, что Вам подошло!

--------------------------------------------------------------

 

очередной пробничек saveAsCopyReplace 2.9.3

 

исправил регресс - по длине 1 строки наименования,

поправил логику считывание и внос свойства Разработал в общ. вкладку и в конфиги (в полной мере не тестил) и отображение во вкладках макроса,
упорядочивание кода - подразбил на подпрограммы, нашёл лишнее ))

изменил считывание и запись в списки файлов настроек

кнопка вызова окна свойств solidworks текущей модели (подсказка от Kir95 - мне понравилось

19.04.2021 в 14:49, Kir95 сказал:

Макрос - открывает окно свойств выбранного в дереве сборки компонента

 

и потестировать удобнее стало, не закрывая макрос пока отлажывал откуда конструктора хавать или нет) - только она сбрасывает вкладки в макросе, но в ней можно поправить и вкладки в макросе пересоздадутся/обновятся

надеюсь по стабильнее стала

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

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

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

 

SaveAsCopyReplace 2.9.3.zip

 

ёмаё, когда уже нормально редактирование сделают. сайт по структуре схож с 4pda, одна ко же редактировать посты или самостоятельно удалить нельзя.

ну вот, раз объединяются, что ж не дать редактировать  - вроде просто - добавьте проверку, если один пользователь писал подряд - обхъединили, тогда не отключать редакцию

как будто на vba для солида сайт написан ))

  • Нравится 2
Link to post
Share on other sites
livedten

мужики а есть макрос или что-то подобное. Если вы работаете с чертежом, то нажав на любой вид и правой кнопкой мыши можно открыть 3D модель данной детали., а вот нет ли такого но от 3D в чертеж

Link to post
Share on other sites
livedten
24 минуты назад, Snake 60 сказал:

Так а чем стандартная кнопка не устраивает?

вопрос снят, я жестко протупил., не знал(сколько работаю не обратил внимание) что в 3D-сборке если нажать пкм на нужную деталь, то появиться иконка для открытия чертежа. Век живи - век учись.

Edited by livedten
  • Нравится 1
Link to post
Share on other sites
tompsongun

SaveAsCopyReplace 2.9.4

решение нескольких выбранных сокращённых моделей,

привёл выборки компонентов к GetSelectedObjectsComponent2 - и их осталось уже только два, а раньше было очень много - результаты не вполне понимаемого копи-паста - надеюсь это приведёт к большей стабильности к кработе в солиде ранее 2017 года.функция хоть и регламентирована как устаревшая, но работает, с 4й версией не осилил с типами объектов и доставания из массивов (ну это со временем, нужно стабилизироваться) ))

 

пока всё )

SaveAsCopyReplace 2.9.4.zip

Edited by tompsongun
  • Нравится 4
  • Чемпион 2
Link to post
Share on other sites
tompsongun

2.9.5

- диалог обзор папки - строка для ввода имени папки,

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

- Al+S - горячая клавиша в интерфейсе макроса  - сохранение копии  (подсказку к кнопе сделал)

- были проблемы с кодировками текстовых файлов (распространялось, вроде, на вновь созданные) - список путей, фио, примечаниия, фирма& разделы - лучше их пересоздать/пересохранить в 1251. или удалить - макрос пересоздаст пустышками

(- еще нашёл где  Set fso = CreateObject("Scripting.FileSystemObject")  сделал,однако же во многих местах продолжал использовать правую часть равенства ))   )

SaveAsCopyReplace 2.9.5.zip

Edited by tompsongun
  • Нравится 1
  • Чемпион 2
Link to post
Share on other sites
Kir95

Макрос - подсчитывает и показывает общее количество (вместе с исключёнными из спецификации) выбранного в дереве проектирования сборки компонента, компонент должен быть решён

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

    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim myAsy As AssemblyDoc
    Dim myCmps
    Dim Cfg As String
    Dim CmpDoc As ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim i As Long
    Dim cCnt As Long
    Dim myCmp As Component2
    Dim tCmp As Component2
    Dim myCmpName As String
'2021/04/26
Option Explicit
   Sub main()
   On Error GoTo swMsg
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set myAsy = swModel
    Set swSelMgr = swModel.SelectionManager
    myCmps = myAsy.GetComponents(False)
     Set myCmp = swSelMgr.GetSelectedObject6(1, -1)
     myCmpName = myCmp.Name2
'     Debug.Print myCmpName
     myCmpName = Mid$(myCmpName, InStrRev(myCmpName, "/") + 1)
      cCnt = 0
      Set CmpDoc = myCmp.GetModelDoc
      If Not CmpDoc Is Nothing Then
        Cfg = myCmp.ReferencedConfiguration
        For i = 0 To UBound(myCmps)
         Set tCmp = myCmps(i)
         If tCmp.GetSuppression <> 0 Then
          If tCmp.GetModelDoc2 Is CmpDoc Then
           If tCmp.ReferencedConfiguration = Cfg Then
            cCnt = cCnt + 1
           End If
          End If
         End If
        Next i
      End If
    MsgBox "Файл (конфигурация): " & myCmpName & " (" & Cfg & ") " & vbCrLf & "К-во общее (вместе с искл. из спец-ии): " & cCnt
Exit Sub
swMsg:
MsgBox "Выберите компонент в дереве сборки и запустите макрос"
End Sub

 

Макрос Общее к-во.jpg

  • Нравится 2
  • Чемпион 1
Link to post
Share on other sites
Kir95
30 минут назад, Snake 60 сказал:

почему он имя выводит с идентификатором? Компонент-1

Какой компанент выбираешь, тот и показывает. Можно идентификатор отсечь, наверное, но, вроде он не мешает особо

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

2021 SOLIDWORKS API Help - Traverse Assembly at Component and Feature Levels Using Recursion Example (VBA)

Link to post
Share on other sites
Snake 60

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

  • Нравится 1
Link to post
Share on other sites
Kir95
13 минут назад, Snake 60 сказал:

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

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

Link to post
Share on other sites
Kelny
14 часов назад, Kir95 сказал:

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

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

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

Link to post
Share on other sites
Kir95
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

 

  • Нравится 1
Link to post
Share on other sites
Kelny
17.01.2019 в 11:43, alek77 сказал:

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

...

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

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

ComponentInfo.bmp

ComponentInfo.swp

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

Edited by Kelny
  • Нравится 2
Link to post
Share on other sites
tompsongun

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

 

  • Нравится 1
Link to post
Share on other sites
Kelny
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

 

  • Нравится 2
Link to post
Share on other sites
tompsongun

 

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

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

 

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

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

 

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

 

Edited by tompsongun
Link to post
Share on other sites
tompsongun

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

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

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

Edited by tompsongun
Link to post
Share on other sites
streamdown
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

  • Нравится 1
Link to post
Share on other sites
tompsongun

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

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

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

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

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

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

 

Edited by tompsongun
Link to post
Share on other sites
Kelny
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

 

Edited by Kelny
  • Нравится 1
  • Чемпион 1
Link to post
Share on other sites
tompsongun

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

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

 

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

Link to post
Share on other sites
streamdown
40 минут назад, tompsongun сказал:

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

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

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

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

Edited by streamdown
  • Нравится 1
Link to post
Share on other sites
Kelny
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

 

Edited by Kelny
Link to post
Share on other sites
Kelny

 

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

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

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

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

Edited by Kelny
  • Нравится 1
Link to post
Share on other sites
tompsongun

SaveAsCopyReplace 3.0.1

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

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

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

 

SaveAsCopyReplace.swp

  • Нравится 2
  • Чемпион 3
Link to post
Share on other sites
tompsongun

SaveAsCopyReplace

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

 

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

Edited by tompsongun
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   1 member

    • mme


  • Сообщения

    • ART
      Если в первой детали разбросать геометрию по цветам и сетам, в последующих просто раскрасить соответственно, то можно вообще ничего не выбирать. Загрузил деталь, выбрал шаблон, включил расчет.    
    • Motek
    • Серый543
      это я нарисовал как примерно должна проходить равнодействующая и где должна проходить. В результате, момент должен получаться раз в 10 меньше, чем выдает программа, тк плечо h будет примерно пол метра. здесь вычисляем моменты относительно глобальной системы координат. а это вычисляем относительно системы координат смещенной на метров 9 по оси x. момент получается практически 0, значит сила проходит именно там. Но это же неправильно...  сетка такая, пробовал еще меньше, но результат тот же. И очень смущает, что в 2018, что в 2019 солиде результат практически совпадает. и модель делал заново - результат тот же.. Кто нибудь может объяснить где я заблуждаюсь, или же напротив почему программа выдает такую дичь.. солид воркс я сносил и чистил хорошо, перед переустановкой  пробовал продувать тестовую пластинку, там момент похож на правду, а здесь не пойму 
    • GS
      === С Праздником Великой Победы над фашизмом ! 
    • EvUgol
    • mestnyi
    • EvUgol
      https://www.youtube.com/watch?v=REOPLWm-IsM
    • mestnyi
      С Великим Праздником, всех форумчан!!  
    • Maik812
    • maxems
      С Днем Победы в Великой Отечественной Войне! Слава советскому воину-освободителю, победившему немецко-фашистских захватчиков и их приспешников в виде поганых бандеровцев и прибалтийских пособников-ублюдков!  
×
×
  • Create New...