Помогите перехватить QSAVE!!!

Помогите перехватить QSAVE!!! · 12.02.2008, 07:15

Мне надо написать реактор который будет перехватывать путь сохранения и делать клоны сохраняемых файлов на сетевых дисках. Проблема в том, что не могу откопать где лежит сама функция qsave!!!!!!! Вобщем просто замена Qsave другую не катит т.к. на каждый комп это ставить и менять имя макроса меня не греет. помогите.

Елпанов Евгений · 12.02.2008, 08:12

Цитата:

Сообщение от alxpavlish

Вобщем просто замена Qsave другую не катит т.к. на каждый комп это ставить и менять имя макроса меня не греет. помогите.

А запускать реактор на каждом компе удобнее?

Кулик Алексей aka kpblc · 12.02.2008, 08:29

Как бы то ни было, все равно обработку командного реактора придется предоставлять на каждую машину. А также прописывать ее в автозагрузку

Если сильно хочется, то нечто типа http://forum.abok.ru/index.php?showt...92&#entry79092

C1 · 12.02.2008, 08:55

А события BeginSave или EndSave не подходят?

Код:

[Выделить все]

Private Sub AcadDocument_BeginSave(ByVal FileName As String)
    MsgBox "A drawing is about to be saved to: " & FileName
End Sub

Profan · 12.02.2008, 08:57

Для alxpavlish.

Цитата:

Проблема в том, что не могу откопать где лежит сама функция qsave!!!!!!!

Покопайся в acad.exe.

Кулик Алексей aka kpblc · 12.02.2008, 09:51

C1, у тебя фактически то же самое, что и у меня, только на VBA. Вот и вся разница

alxpavlish · 12.02.2008, 12:42

Как на каждый комп? Я подгружу этот лсп файл в дистрибутив и буду всем ставить, а изменять имя стандартного макроса не могу в дистрибутиве. VBA не катит т.к. я бэйсик принципиально игнорирую. Ещё версии есть? Спасибо.

Кулик Алексей aka kpblc · 12.02.2008, 12:49

Подгрузить в дистрибутив? Если это разговор о сетевом разветывании, то этого мало. Его (лисп то бишь) надо еще и в AutoCAD загрузить

alxpavlish · 12.02.2008, 13:25

Цитата:

Сообщение от Кулик Алексей aka kpblc

Подгрузить в дистрибутив? Если это разговор о сетевом разветывании, то этого мало. Его (лисп то бишь) надо еще и в AutoCAD загрузить

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

Может я неточно сформировал проблему... опишу по новой

нужно что бы человек который сидел за компом и работал в автокаде нажимал на иконнку сохранения(макрос этой кнопки ^C^C_qsave ), далее наш реактор смотрит, ага надо выполнить qsave, прехватывает эту команду и меняет её на то что нам надо, а нам надо что бы наш реактор посмотрел где лежит сам сохраняемый кусэйвом файл(например С:\\project\test) взял часть этого пути , а именно "project\test" и сохранил этот файл в несколько мест, т.е. пересохранил сам файл сработав как тупо макрос qsave и сохранил на сервер, к примеру (\\\\server\\project\\test) ессно всё это добро подгружается на каждую отдельную машину и тп. не об этом речь, а вообще как подменить его..

такой код не пойдёт! нужен именно реактор(((.

(defun c:bsave (/ dwg_name dwg_path)
(setvar "cmdecho" 0)
(if (= (getvar "dwgtitled") 0)
(progn
(initdia)
(command "_.save")
);end progn
);end if

(setq dwg_name (getvar "dwgname"))
(setq dwg_path (getvar "dwgprefix"))

(command "qsave")

(command "_.saveas" "2007" (strcat "\\\\main-server\\NET_DISK\\!SYSTEM\\test\\copy_of_" dwg_name) "Y")
(command "_.saveas" "2007" (strcat dwg_path dwg_name) "Y")
(command "_.saveas" "2007" (strcat "\\\\main-server\\NET_DISK\\!SYSTEM\\test2\\copy_of_" dwg_name) "Y")
(command "_.saveas" "2007" (strcat dwg_path dwg_name) "Y")

(princ)
); end bsave
хорошая помосчь не останетя незамеченной (wmr рулит))))

Кулик Алексей aka kpblc · 12.02.2008, 14:53

Так я ж привел ссылку на реактор!
Вариант с установкой даты в имени файла:

Код:

[Выделить все]

(vl-load-com)
(or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of or
(or *kpblc-svr*
    (setq *kpblc-svr* (vlax-get-or-create-object "scripting.filesystemobject"))
    ) ;_ end of or

(if *vlr-cmd*
  (progn (setq *vlr-cmd* nil) (vlr-remove-all :vlr-command-reactor))
  ) ;_ end of if
(if (not *vl-cmd*)
  (setq
    *vlr-cmd* (vlr-command-reactor nil '((:vlr-commandended . cmd-end)))
    ) ;_ end of setq
  ) ;_ end of if

(defun cmd-end (reactor cmd / date name path)
  (setq cmd (strcase (car cmd) t))
  (if (and (wcmatch cmd "*save*")
           (= (getvar "dwgtitled") 1)
           ) ;_ end of and
    (progn
      (setq name (strcat
                   (substr
                     (vl-filename-base
                       (vla-get-name *kpblc-activedoc*)
                       ) ;_ end of vl-filename-base
                     1
                     (vl-string-search
                       (strcat "_"
                               (substr (setq date (rtos (getvar "cdate") 2)) 1 4)
                               "-"
                               ) ;_ end of strcat
                       (vl-filename-base
                         (vla-get-name *kpblc-activedoc*)
                         ) ;_ end of vl-filename-base
                       ) ;_ end of vl-string-search
                     ) ;_ end of substr
                   "_"
                   (substr (setq date (rtos (getvar "cdate") 2)) 1 4)
                   "-"
                   (substr date 5 2)
                   "-"
                   (substr date 7 2)
                   ) ;_ end of strcat
            path (vl-filename-directory (vla-get-fullname *kpblc-activedoc*))
            ) ;_ end of setq
      (vla-saveas *kpblc-activedoc* (strcat path "\\" name ".dwg") acnative)
      (vlax-invoke-method
        *kpblc-svr*
        'copyfile
        (strcat path "\\" name ".dwg")
        (strcat "c:\\1\\" name ".dwg")
        :vlax-true
        ) ;_ end of vlax-invoke-method
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

То же самое, но без переименования:

Код:

[Выделить все]

(vl-load-com)
(or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of or
(or *kpblc-svr*
    (setq *kpblc-svr* (vlax-get-or-create-object "scripting.filesystemobject"))
    ) ;_ end of or

(if *vlr-cmd*
  (progn (setq *vlr-cmd* nil) (vlr-remove-all :vlr-command-reactor))
  ) ;_ end of if
(if (not *vl-cmd*)
  (setq
    *vlr-cmd* (vlr-command-reactor nil '((:vlr-commandended . cmd-end)))
    ) ;_ end of setq
  ) ;_ end of if

(defun cmd-end (reactor cmd / path name)
  (setq cmd (strcase (car cmd) t))
  (if (and (wcmatch cmd "*save*")
           (= (getvar "dwgtitled") 1)
           ) ;_ end of and
    (progn
      (setq name (vla-get-name *kpblc-activedoc*)
            path (vl-filename-directory (vla-get-fullname *kpblc-activedoc*))
            ) ;_ end of setq
      (vla-saveas *kpblc-activedoc* (strcat path "\\" name ".dwg") acnative)
      (vlax-invoke-method
        *kpblc-svr*
        'copyfile
        (strcat path "\\" name ".dwg")
        (strcat "c:\\1\\" name ".dwg")
        :vlax-true
        ) ;_ end of vlax-invoke-method
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Пробуй, поскольку тщательно я не гонял.

alxpavlish · 13.02.2008, 17:53

Спасибо!! Я просто забыл сказать, что у меня ссылка не работает...не знаю.....спасибо буду работать!!!!

alxpavlish · 15.02.2008, 04:58

Код:

[Выделить все]

(vl-load-com)
(or *shpil-activedoc*
    (setq *shpil-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of or
(or *shpil-svr*
    (setq *shpil-svr* (vlax-get-or-create-object "scripting.filesystemobject"))
    ) ;_ end of or

(if *vlr-cmd*
  (progn (setq *vlr-cmd* nil) (vlr-remove-all :vlr-command-reactor))
  ) ;_ end of if
(if (not *vl-cmd*)
  (setq
    *vlr-cmd* (vlr-command-reactor nil '((:vlr-commandended . cmd-end)))
    ) ;_ end of setq
  ) ;_ end of if

(defun cmd-end (reactor cmd / date name path)
  (setq cmd (strcase (car cmd) t))
  (if (and (wcmatch cmd "*save*")
           (= (getvar "dwgtitled") 1)
           ) ;_ end of and
    (progn
      (setq name (strcat
                   (substr
                     (vl-filename-base
                       (vla-get-name *shpil-activedoc*)
                       ) ;_ end of vl-filename-base
		     1
                     (vl-string-search
                       (strcat "_"
                               (substr (setq date (rtos (getvar "cdate") 2)) 5 2)
                               "-"
                               ) ;_ end of strcat
                       (vl-filename-base
                         (vla-get-name *shpil-activedoc*)
                         ) ;_ end of vl-filename-base
                       ) ;_ end of vl-string-search
                     ) ;_ end of substr
                   "_"
                   (substr (setq date (rtos (getvar "cdate") 2)) 5 2)
                   "-"
                   (substr date 7 2)
                   "-"
                   (substr date 10 2)
		   "-"
                   (substr date 12 2)
                   ) ;_ end of strcat
            path (vl-filename-directory (vla-get-fullname *shpil-activedoc*))
            ) ;_ end of setq
      (vla-saveas *shpil-activedoc* (strcat path "\\" name ".dwg") acnative)
      (vlax-invoke-method
        *shpil-svr*
        'copyfile
        (strcat path "\\" name ".dwg")
        (strcat "c:\\1\\" name ".dwg")
	:vlax-true
        ) ;_ end of vlax-invoke-method
	) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Кулик Алексей aka kpblc · 15.02.2008, 14:48

И ето чего?

acyxou · 24.03.2009, 12:05

Извините что пишу в эту тему, не люблю создавать новые....
Вот моя цитата, проблему так и не решил. Ребят проверьте у себя, у вас также при переопределении qsave временно слетает filedia?

Цитата:

Сделал redefine сомманды _qsave так, чтоб сначала выполнялся сброс масштабов (-scalelistedit), а затем уже .qsave. Так вот, се работает прекрасно если чертеж не новый. Т.е. если создать новый чертеж и воспользоваться этой коммандой чтоб впервые его сохранить и присвоить ему имя, то чертеж не сохраняется, точнее переменная Filedia слетает в ноль и просит вручную прописать путь и имя файла. Что с этим делать, никто не знает?

Код:

[Выделить все]

(command "UNDEFINE" "_QSAVE")
(defun c:qsave ()
  (setvar "CMDECHO" 0)
  (command "-Scalelistedit" "_r" "_y" "_e")
  (command "_.qsave")
  (setvar "CMDECHO" 1)
  (princ)
)

nik_mb · 24.03.2009, 14:58

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

Код:

[Выделить все]

;************************************************* ***
(defun startlisp (calling-reactor startlispInfo /
thelispstart)
(setq thelispstart (nth 0 startLispInfo))
(pred_kol)
);defun
;************************************************* ***
(defun endlisp (calling-reactor endlispInfo /
thelispend)
(if pol_dat (pod_kol))
);defun
;************************************************* ***
(defun startcommand (calling-reactor startcommandInfo /
thecommandstart)
(setq thecommandstart (nth 0 startcommandInfo))
(if (not (= thecommandstart "UNDO"))(pred_kol));;;;
(cond
((= thecommandstart "MCDEDIT") (sbor_nab_edit))
((= thecommandstart "DDEDIT") (sbor_nab_edit))
;; и много такого еще
);cond
);defun 
;************************************************* ***
(defun endcommand (calling-reactor endcommandInfo /
thecommandend)
(setq thecommandend (nth 0 endcommandInfo))
(if (and (not (= thecommandend "UNDO")) pol_dat)(pod_kol));;;
(cond
((= thecommandend "STRETCH")(mod_stretch));; для размеров
((= thecommandend "GRIP_STRETCH") (mod_grip));; для размеров
((= thecommandend "EATTEDIT") (prov_bl));; для автосчета и выносок
((= thecommandend "MCDEDIT") (compare_txt_edit));; для автосчета и выносок
((= thecommandend "DDEDIT") (compare_txt_edit));; для автосчета и выносок
);cond
);defun 
;************************************************* **
(vlr-lisp-reactor
nil '((:vlr-lispWillStart . startlisp)))
(vlr-lisp-reactor
nil '((:vlr-lispEnded . endlisp)))
(vlr-command-reactor
nil '((:vlr-commandEnded . endcommand)))
(vlr-command-reactor
nil '((:vlr-commandWillStart . startcommand)))
;************************************************* **
;; теперь одна из исполняемых функций как пример 
(defun pred_kol()
(if (= thecommandstart "PLOT")(setq mshtb nil))
(if (= predcomand "QSAVE")(vlax-invoke-method ActiveDocument "Save"))
(if (= thecommandstart "SAVEAS")(zam_txt))
)

Узнать оригинальное имя команды можно печатая переменную из реактора "thecommandstart" или "thecommandend".
зы.Последний раз редактировалось Кулик Алексей aka kpblc, Вчера в 21:26. Вот это мне непонятно

acyxou · 25.03.2009, 14:29

мда... глаз сломаешь... не очень то и читабельно

Кулик Алексей aka kpblc · 25.03.2009, 19:52

nik_mb, ты про тэги [code] забыл. Я их тебе поставил.

nik_mb · 25.03.2009, 20:27

Цитата:

Сообщение от Кулик Алексей aka kpblc

nik_mb, ты про тэги [code] забыл. Я их тебе поставил.

Спасибо конечно, но текст сегодня был...

Цитата:

Сообщение от acyxou

мда... глаз сломаешь... не очень то и читабельно

Пришлось, теперь мне подправлять.
ЗЫ. На этом форуме я пока не освоился, возможно недопонимание некоторых правил.

Кулик Алексей aka kpblc · 25.03.2009, 20:57

Это про какой текст разговор? Я твой пост исправлял только в той части, в которой и говорил.

12.02.2008, 07:15		#1
Помогите перехватить QSAVE!!! alxpavlish Регистрация: 12.02.2008 Сообщений: 5 Мне надо написать реактор который будет перехватывать путь сохранения и делать клоны сохраняемых файлов на сетевых дисках. Проблема в том, что не могу откопать где лежит сама функция qsave!!!!!!! Вобщем просто замена Qsave другую не катит т.к. на каждый комп это ставить и менять имя макроса меня не греет. помогите.
Просмотров: 4430

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Помогите Пожалуйста найти и скачать книгу Ф. А. Байтемиров, В. М. Головина, Э. М. Улицкая Расчет кон	DenIZ	Поиск литературы, чертежей, моделей и прочих материалов	0	27.12.2007 22:45
ПОМОГИТЕ!! при выводе на печать ПУСТО	nikashkoda	AutoCAD	11	16.12.2007 19:11