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

[kimk 0]

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

<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: Если вопрос "глупый" прошу ногами не бить

[Ruslan 266]

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

`File.psh_save`;\

sk "^s"

повторение?

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

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

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

[GOLF_stream 292]

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

[Bear_p 0]

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

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

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

Изменено 3 сентября 2007 пользователем Bear_p

[Ruslan 266]

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

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()

[kimk 0]

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

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

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

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

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

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

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

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

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

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

[Ruslan 266]

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

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

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

sk "drw"

на sk "DRW"

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

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

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

[Ruslan 266]

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

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

Это в конфиг. Ссылку на файл исправить на свою. Внимание Макросов с именами 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 время задержки для выбора формата (двойной клик на файле).

[NCuser 0]

Sorry

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

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

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

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

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

[Ruslan 266]

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

[NCuser 0]

Да, исправил --> имя файла дается, но 125 не забивается, только вручную удалять...

[Ruslan 266]

Попробуйте увеличить первую задержку. WScript.Sleep 100

[Karlik 0]

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

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()

[NCuser 0]

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

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

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

[Ruslan 266]

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()

[NCuser 0]

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

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

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

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

[AlexanderM 1]

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

[Ruslan 266]

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

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

[Ruslan 266]

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

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

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

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

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

Принцип:

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

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

[Karlik 0]

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