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

Vba + Mapkey - Открытие Одноименного Чертежа


kimk

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

Кому интересно, оригинал на:

<noindex>http://ww3.cad.de/foren/ubb/Forum12/HTML/010934.shtml#000022</noindex>

вносим в config.pro:

!================================================

! открыть чертеж

!================================================

mapkey zщ @MAPKEY_NAMEоткрыть чертеж;@MAPKEY_LABELоткрыть чертеж;\

mapkey(continued) ~ Activate `main_dlg_cur` `File.psh_save`;\

mapkey(continued) @SYSTEM\start WScript.exe H:\\Zusatz_Prog\\zo.vbs

!================================================

создаем "zo.vbs":

'Option Explizit

WScript.Sleep 100

Dim Fi, Fso

Set Shell = CreateObject("WScript.Shell")

Set WshShell = WScript.CreateObject("WScript.Shell")

Sub sk(Befehl)

'wscript.echo befehl

WshShell.SendKeys(Befehl)

WScript.Sleep 50

End Sub

sk "^s"

sk "{TAB 6}"

sk "{BS 3}"

sk "drw"

sk "+^{left}"

sk "^c"

sk "^a"

sk "^o"

sk "^v"

sk "~"

WScript.Quit()

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

У народа все прекрасно работает, если названия моделей - цифры.

У меня же - названия "осмысленные", типа "Stenka_levaja.asm"

По-этому в диалог попадает названия файла ВСЕ_БОЛЬШИМИБУКВАМИ и система соответствующий чертеж не находит.

Вопрос: как переписать скрипт так:

......

sk "^s"

sk "{TAB 6}"

sk "{BS 3}"

sk "drw"

sk "+^{left}"

sk "^c"

sk "^a"

sk "^o"

получить из стека последнюю сохраненную строку

применить к ней "LCase()

записать ее назад в стек

sk "^v"

sk "~"

.......

PS: Если вопрос "глупый" прошу ногами не бить

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


Класный макрос! Только не понятно почему:

`File.psh_save`;\

sk "^s"

повторение?

У меня же - названия "осмысленные", типа "Stenka_levaja.asm"

От этого не должно зависеть. Для Прое что с верхним, что с нижним регистром это одинаковые файлы. И он нормально их открывает.

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

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

Хороший скрипт... У меня работает... Но Я файлы нвзываю цифровым кодом чертежа.

хотя и так работает... Файл SHPONKA_4X4 и находит его чертеж...

У тебя случайно никакой папки с рускими буквами нет??? А может чертеж называется немного по другому...

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

Вот мой итоговый вариант открытия существующего чертежа.:

mapkey hertej @MAPKEY_NAMEОткрыть чертёж;@MAPKEY_LABELЧертёж; \

mapkey(continued) @SYSTEM\start Wscript.exe D:\\User3\\open_file.vbs;

Dim WshShell



set WshShell = WScript.CreateObject("WScript.Shell")



WshShell.SendKeys "^S"



WshShell.SendKeys "{Tab 6}"



WshShell.SendKeys "{bs 4}"



WshShell.SendKeys "+{Home}"



WshShell.SendKeys "^C"



WshShell.SendKeys "^O"



WshShell.SendKeys "{Tab}"



WshShell.SendKeys "{Down 3}"



WshShell.SendKeys "{Tab 14}"



WshShell.SendKeys "^V"



WshShell.SendKeys "{Enter}"



WScript.Quit()

Скрипт создания файла чертежа:

Dim WshShell



set WshShell = WScript.CreateObject("WScript.Shell")



WshShell.SendKeys "^S"



WshShell.SendKeys "{Tab 6}"



WshShell.SendKeys "{bs 4}"



WshShell.SendKeys "+{Home}"



WshShell.SendKeys "^C"



WshShell.SendKeys "^N"



WshShell.SendKeys "{Tab 8}"



WshShell.SendKeys "{Down}"



WshShell.SendKeys "{Tab 8}"



WshShell.SendKeys "{Down}"



WshShell.SendKeys "{Tab 8}"



WshShell.SendKeys "{Down}"



WshShell.SendKeys "^V"



WshShell.SendKeys "{Enter}"



WScript.Sleep 500



WshShell.SendKeys "^V"



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

хотя и так работает... Файл SHPONKA_4X4 и находит его чертеж...

У тебя случайно никакой папки с рускими буквами нет??? А может чертеж называется немного по другому...

Нет ни Русских ни каких других и файлы чертежей наместе.

Не знаю почему, но регистр влияет. :-(

Ладно переживу, но теперь просто принципиально интересно:

Как, всетаки, получить из "буфера обмена" строку, сделать все буквы маааленькими и передать эту строку обратно :-)))

quote name='GOLF_stream' date='Sep 2 2007, 23:35' post='170060']

нифига не понял. О чём речь?

Чтож непонятного: Я прсто очень ленивый: надо раз 5 мышкой кликнуть, потом ^C-жать, потом ^V, а так 2 кнопочки нажал и чертежик открылся.

К стати таким же способом можно СОЗДАТЬ чертеж, надо только после выбора рамки (формата) не забыть Sleep() вставить, чтобы датьсебе время для выбора формата, отличного от "по умолчанию"

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

Как, всетаки, получить из "буфера обмена" строку, сделать все буквы маааленькими и передать эту строку обратно :-)))

Не надо ничего делать. Попробуй мой вариант.

Или в своем варианте замени:

sk "drw"

на sk "DRW"

раскладка в ПроЕ английская.

надо только после выбора рамки (формата)

Тут проблема, к получению доступа к форматам.

Ссылка на сообщение
Поделиться на других сайтах
  • 2 месяца спустя...

Тут на днях занялся и нашол решение не зависящее от раскладки и имени файла.

Открытие чертежа:

Это в конфиг. Ссылку на файл исправить на свою. Внимание Макросов с именами 1, 12 в конфиге быть не должно. Первый макрос для кнопки.

mapkey hertej @MAPKEY_NAMEОткрыть чертёж;@MAPKEY_LABELОткрыть чертёж;\

mapkey(continued) @SYSTEM\start WScript.exe D:\\User3\\Макросы\\Скрипты\\open_drw.vbs;



mapkey 123 @MAPKEY_NAMEЧертеж;@MAPKEY_LABELЧертеж;\

mapkey(continued) ~ Activate `main_dlg_cur` `ProCmdModelOpen.file`;~ Open `file_open` `Type`;\

mapkey(continued) ~ Close `file_open` `Type`;~ Select `file_open` `Type`1  `db_4`;\

mapkey(continued) ~ Input `file_open` `Inputname` `1`;~ Input `file_open` `Inputname` ``;\

mapkey(continued) ~ Update `file_open` `Inputname` ``;



mapkey 124 @MAPKEY_NAMEПереименовать;@MAPKEY_LABELПереименовать;\

mapkey(continued) ~ Select `main_dlg_cur` `MenuBar1`1  `File`;\

mapkey(continued) ~ Close `main_dlg_cur` `MenuBar1`;\

mapkey(continued) ~ Activate `main_dlg_cur` `File.psh_rename`;

А это файл. Внимание, если не работает попробуйте ключи ^C ^A ^V заменить на ^c ^a ^v. Зависит от машины.

Dim WshShell



set WshShell = WScript.CreateObject("WScript.Shell")



WshShell.SendKeys "124"



WScript.Sleep 100



WshShell.SendKeys "^C"



WshShell.SendKeys "^A"



WScript.Sleep 300



WshShell.SendKeys "123"



WScript.Sleep 300



WshShell.SendKeys "^V"



WshShell.SendKeys "{Enter}"



WScript.Quit()

Создание файла чертежа по модели:

Это в конфиг, включая 124 макрос выше. Первый макрос для кнопки.

mapkey hertej_new1 @MAPKEY_NAMEСоздать чертёж;@MAPKEY_LABELСоздать чертёж;\

mapkey(continued) @SYSTEM\start Wscript.exe D:\\User3\\Макросы\\Скрипты\\create_drw.vbs;



mapkey 125 @MAPKEY_NAMEЧертеж новый;@MAPKEY_LABELЧертеж новый;\

mapkey(continued) ~ Select `main_dlg_cur` `MenuBar1`1  `File`;\

mapkey(continued) ~ Close `main_dlg_cur` `MenuBar1`;~ Activate `main_dlg_cur` `File.psh_new`;\

mapkey(continued) ~ Select `new` `Type`1  `Drawing`;~ Input `new` `InputPanel1` ``;\

mapkey(continued) ~ Update `new` `InputPanel1` ``;



mapkey 126 @MAPKEY_NAMEФормат;@MAPKEY_LABELВыбрать формат;\

mapkey(continued) ~ FocusIn `dwg_create` `inp_model_name`;\

mapkey(continued) ~ Select `dwg_create` `rad_format`1  `2`;\

mapkey(continued) ~ Activate `dwg_create` `psh_format_browse`;

Это файл.

Dim WshShell



set WshShell = WScript.CreateObject("WScript.Shell")



WshShell.SendKeys "124"



WScript.Sleep 100



WshShell.SendKeys "^C"



WshShell.SendKeys "^A"



WScript.Sleep 300



WshShell.SendKeys "125"



WScript.Sleep 300



WshShell.SendKeys "^V"



WshShell.SendKeys "{Enter}"



WshShell.SendKeys "^V"



WshShell.SendKeys "{Tab}" 



WshShell.SendKeys "126"



WScript.Sleep 4000



WshShell.SendKeys "{Enter}"



WshShell.SendKeys "{Enter}"



WScript.Quit()

WScript.Sleep 4000 время задержки для выбора формата (двойной клик на файле).

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

Sorry

Проверил работу скриптов, макрос "Создать одноименный чертеж" не работает:

- в строке NEW NAME панели RENAME курсор появляется в режиме вставки,

- в ней запись - 125

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

Как это исправить?

:sad:

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

Про какой макрос разговор? Если про последний, то я уже писал вверху что зависит от машины написание некоторых знаков: ^C ^A ^V заменить на ^c ^a ^v.

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

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

Dim WshShell

set WshShell = WScript.CreateObject("WScript.Shell")

WshShell.SendKeys "124"

WScript.Sleep 300

WshShell.SendKeys "^c"

WshShell.SendKeys "^a"

WScript.Sleep 300

WshShell.SendKeys "125"

WScript.Sleep 300

WshShell.SendKeys "^v"

WshShell.SendKeys "{Enter}"

WScript.Sleep 300

WshShell.SendKeys "^v"

WshShell.SendKeys "{Tab}"

WshShell.SendKeys "126"

WScript.Sleep 4000

WshShell.SendKeys "{Enter}"

WshShell.SendKeys "{Enter}"

WScript.Quit()

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

Sorry. Мы в 2001, потому и не катит.

на Java может и прокатило бы, если заменить <^A> на <Alt F4>

а WF это со свистом конечно.

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

Sorry. Мы в 2001, потому и не катит.

на Java может и прокатило бы, если заменить <^A> на <Alt F4>

В 2001 тоже работает.

Dim WshShell

set WshShell = WScript.CreateObject("WScript.Shell")

WshShell.SendKeys "124"

WScript.Sleep 100

WshShell.SendKeys "^c"

WScript.Sleep 100

WshShell.SendKeys "%{F4}"

WScript.Sleep 300

WshShell.SendKeys "125"

WScript.Sleep 300

WshShell.SendKeys "^v"

WshShell.SendKeys "{Enter}"

WshShell.SendKeys "^v"

WshShell.SendKeys "{Tab}"

WshShell.SendKeys "126"

WScript.Sleep 4000

WshShell.SendKeys "{Enter}"

WshShell.SendKeys "{Enter}"

WScript.Quit()

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

Это делал уже, не выходит из меню RENAME.

Может собака зарыта в мапкее?

Извиняюсь, не там поправил.

Спасибо работает.

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

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

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

Ну любим мы автоматизацию рутины.

А если в папке чертежей двести? или вообще в другой директории?

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

Просьба, кому не лень проверить данный макрос.

Это в конфиг, Директорию изменить на свою:

mapkey Pod @MAPKEY_NAMEПрописать дополнительную информацию под размером;\

mapkey(continued) @MAPKEY_LABELПодписать размер;\

mapkey(continued) @SYSTEM\start D:\\User3\\Макросы\\Скрипты\\podpis_razmera.exe;

Принцип:

В чертеже выделяете размер (Радиус, Диаметр отв., фаску(45), Диаметр резьбы (M@D), остальные размеры), запустите макрос.

Дожно получится в итоге: # радиусов, # отв., #фасок, # отв., # мест.

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

В результате работы макроса создается сборочная единица с именем "100" - в размер ничего не добавляется.

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

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

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

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

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

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

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

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

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

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

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




×
×
  • Создать...