Autolisp. Отчет о закрытии и открытии чертежа.

Zaghim · 29.06.2012, 13:40

Друзья, помогите сделать лисп, который сохранял бы по указанному пути время и имя пользователя, когда он открывает чертеж и когда его закрывает. В идеале было бы еще проверка, открыт чертеж или нет, например каждые 5 минут, что бы избежать проблем, когда кад аварийно закрывается.

TararykovDG · 29.06.2012, 14:34

Цитата:

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

помогите сделать лисп

Помогаю, используй реакторы

gomer · 29.06.2012, 14:39

А как это поможет при вылете?

TararykovDG · 29.06.2012, 14:53

Цитата:

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

А как это поможет при вылете?

При вылете никак, но можно настроить автосохранение с нужным интервалом, и опять же реактором при автосохранении писать в отдельный файл необходимую инфу

Zaghim · 29.06.2012, 15:05

Народ, тема актуальна... помогите подправить код!

Накидал чутка... помогите все в кучу собрать

Код:

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

(defun reac3 ( / )
; Создание реактора команд
(setq cmr (vlr-dwg-reactor "Реактор команд: "
  (list '(:vlr-enddwgopen . undel)
    '(:vlr-savecomplete . undel1)
    '(:vlr-beginclose . undel2)))
);setq
);defun reac3


(defun undel (reac cname / _ad)
(princ (strcat "\n" (vlr-data reac) " контролирую "))
(princ cname)
(setq _ad (vla-get-ActiveDocument (vlax-get-acad-object)))
; Проверка имени команды
(if (member (getcname (car cname)) (list "ERASE" "_ERASE"))
  (progn
    (vla-SendCommand _ad "_.UNDO ")
    (vla-SendCommand _ad "1 ")
  );progn
);if
);defun undel

(defun undel1 (reac1 cname1 / _ad1)
(princ (strcat "\n" (vlr-data reac1) " контролирую "))
(princ cname1)
(setq _ad1 (vla-get-ActiveDocument (vlax-get-acad-object)))
; Проверка имени команды
(if (member (getcname (car cname1)) (list "ERASE" "_ERASE"))
  (progn
    (vla-SendCommand _ad1 "_.UNDO ")
    (vla-SendCommand _ad1 "1 ")
  );progn
);if
);defun undel

(defun c:wndate( / nam  dat tday tmon tyer strok1 strok2 pt old_cmd)

 (setq old_cmd  (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)

 (setq dat (itoa (fix(getvar "CDATE")))
       time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
       nam (getvar "DWGNAME")
       nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
       tday (substr dat 7 2)
       tmon (substr dat 5 2)
       tyer (substr dat 1 4)
       thh (substr time 1 2)
       tmm (substr time 3 2)
       tss (substr time 5 2) 

  strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

  strok1 (strcat "Имя файла: " nam )
  strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
        pt (getpoint "\nТочка вставки текста: ")
 )
 (COMMAND "TEXT" pt 2.0 0 strok1)
 
 (setq pt (list (car pt) (-(cadr pt) 3.)))
 (COMMAND "TEXT" pt 2.0 0 strok2)
 (setvar "CMDECHO" old_cmd)
 (princ)
)

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

Код:

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

(defun reac3 ( / )
; Создание реактора команд
(setq cmr (vlr-dwg-reactor "Реактор команд: "
  (list '(:vlr-enddwgopen . undel)
    '(:vlr-savecomplete . undel1)
    '(:vlr-beginclose . undel2)))
);setq
);defun reac3


(defun undel (reac cname / _ad)
  (setq file  (findfile "bb.txt")
        fp    (open file "w")
  );setq
  (wndate)
  (write-line stroka1 fp)
  (write-line stroka2 fp)
)

(defun undel1 (reac cname / _ad)
  (setq file  (findfile "bb.txt")
        fp    (open file "w")
  );setq
  (wndate)
  (write-line stroka1 fp)
  (write-line stroka2 fp)
)

(defun undel2 (reac cname / _ad)
  (setq file  (findfile "bb.txt")
        fp    (open file "w")
  );setq
  (wndate)
  (write-line stroka1 fp)
  (write-line stroka2 fp)
)



(defun wndate ( / nam  dat tday tmon tyer strok1 strok2 pt old_cmd)

 ;(setq old_cmd  (getvar "CMDECHO"))
 ;(setvar "CMDECHO" 0)

 (setq dat (itoa (fix(getvar "CDATE")))
       time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
       nam (getvar "DWGNAME")
       nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
       tday (substr dat 7 2)
       tmon (substr dat 5 2)
       tyer (substr dat 1 4)
       thh (substr time 1 2)
       tmm (substr time 3 2)
       tss (substr time 5 2) 

  strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

  strok1 (strcat "Имя файла: " nam )
  strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
        ;pt (getpoint "\nТочка вставки текста: ")
 )
 ;(COMMAND "TEXT" pt 2.0 0 strok1)
 
 ;(setq pt (list (car pt) (-(cadr pt) 3.)))
 ;(COMMAND "TEXT" pt 2.0 0 strok2)
 ;(setvar "CMDECHO" old_cmd)
 ;(princ)
)

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

Еще вариант, тоже не воркает...

Код:

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

(defun reac3 ( / )
; Создание реактора команд
(setq cmr (vlr-dwg-reactor "Реактор команд: "
  (list '(:vlr-enddwgopen . undel)
    '(:vlr-savecomplete . undel)
    '(:vlr-beginclose . undel)))
);setq
);defun reac3


(defun undel ()
  (setq file  (findfile "bb.txt")
        fp    (open file "w")
  );setq
  (setq dat (itoa (fix(getvar "CDATE")))
       time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
       nam (getvar "DWGNAME")
       nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
       tday (substr dat 7 2)
       tmon (substr dat 5 2)
       tyer (substr dat 1 4)
       thh (substr time 1 2)
       tmm (substr time 3 2)
       tss (substr time 5 2) 

  strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

  strok1 (strcat "Имя файла: " nam )
  strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
 )
  (write-line strok1 fp)
  (write-line strok2 fp)
)

Zaghim · 03.07.2012, 11:53

В общем решил свою проблему самостоятельно. Возможно кому-то пригодится.

Код:

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

 (vl-load-com)


(setq cmr (vlr-dwg-reactor "Реактор файлов: "
  (list '(:vlr-dwgfileopened . undel)
    '(:vlr-databaseconstructed . undel)
    '(:vlr-begindwgopen . undel)
    '(:vlr-enddwgopen . undel)
        '(:vlr-savecomplete . undel1)
        '(:vlr-beginclose . undel2)))
);setq

(setq file  (findfile "cc.txt")
          fp    (open file "a")
    );setq
    (setq dat (itoa (fix(getvar "CDATE")))
          time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
          nam (getvar "DWGNAME")
          nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
          tday (substr dat 7 2)
          tmon (substr dat 5 2)
          tyer (substr dat 1 4)
          thh (substr time 1 2)
          tmm (substr time 3 2)
          tss (substr time 5 2) 

          strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

          strok1 (strcat "Имя файла: " nam )
          strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
      strok3 (strcat "Действие: " "Чертеж открыт")
    )
    (write-line strok2 fp)
    (write-line strok1 fp)
    (write-line strok3 fp)
    
    (princ)



(defun undel (reac cname / _ad)
;(princ (strcat "\n" (vlr-data reac) " контролирую "))
;(princ cname)
(setq _ad (vla-get-ActiveDocument (vlax-get-acad-object)))
; Проверка имени команды
;(if (member (getcname (car cname)) (list "SAVE" "_SAVE" "QSAVE" "_QSAVE" "OPEN" "_OPEN" "QNEW" "_QNEW" "CLOSE" "_CLOSE"))
  ;(progn
    (setq file  (findfile "cc.txt")
          fp    (open file "a")
    );setq
    (setq dat (itoa (fix(getvar "CDATE")))
          time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
          nam (getvar "DWGNAME")
          nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
          tday (substr dat 7 2)
          tmon (substr dat 5 2)
          tyer (substr dat 1 4)
          thh (substr time 1 2)
          tmm (substr time 3 2)
          tss (substr time 5 2) 

          strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

          strok1 (strcat "Имя файла: " nam )
          strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
      strok3 (strcat "Действие: " "Чертеж открыт")
    )
    (write-line strok2 fp)
    (write-line strok1 fp)
    (write-line strok3 fp)
    
    (princ)
    ;(vla-SendCommand _ad "_.UNDO ")
    ;(vla-SendCommand _ad "1 ")
  ;);progn
;);if
);defun undel


(defun undel1 (reac cname / _ad)
;(princ (strcat "\n" (vlr-data reac) " контролирую "))
;(princ cname)
(setq _ad (vla-get-ActiveDocument (vlax-get-acad-object)))
; Проверка имени команды
;(if (member (getcname (car cname)) (list "SAVE" "_SAVE" "QSAVE" "_QSAVE" "OPEN" "_OPEN" "QNEW" "_QNEW" "CLOSE" "_CLOSE"))
  ;(progn
    (setq file  (findfile "cc.txt")
          fp    (open file "a")
    );setq
    (setq dat (itoa (fix(getvar "CDATE")))
          time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
          nam (getvar "DWGNAME")
          nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
          tday (substr dat 7 2)
          tmon (substr dat 5 2)
          tyer (substr dat 1 4)
          thh (substr time 1 2)
          tmm (substr time 3 2)
          tss (substr time 5 2) 

          strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

          strok1 (strcat "Имя файла: " nam )
          strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
      strok3 (strcat "Действие: " "Чертеж сохранен")
    )
    (write-line strok2 fp)
    (write-line strok1 fp)
    (write-line strok3 fp)
    
    (princ)
    ;(vla-SendCommand _ad "_.UNDO ")
    ;(vla-SendCommand _ad "1 ")
  ;);progn
;);if
);defun undel

(defun undel2 (reac cname / _ad)
;(princ (strcat "\n" (vlr-data reac) " контролирую "))
;(princ cname)
(setq _ad (vla-get-ActiveDocument (vlax-get-acad-object)))
; Проверка имени команды
;(if (member (getcname (car cname)) (list "SAVE" "_SAVE" "QSAVE" "_QSAVE" "OPEN" "_OPEN" "QNEW" "_QNEW" "CLOSE" "_CLOSE"))
  ;(progn
    (setq file  (findfile "cc.txt")
          fp    (open file "a")
    );setq
    (setq dat (itoa (fix(getvar "CDATE")))
          time (rtos (fix (* 1000000 (- (getvar "cdate") (fix (getvar "cdate"))))) 2 0)
          nam (getvar "DWGNAME")
          nam (strcat (getvar "DWGPREFIX")(getvar "DWGNAME"))
          tday (substr dat 7 2)
          tmon (substr dat 5 2)
          tyer (substr dat 1 4)
          thh (substr time 1 2)
          tmm (substr time 3 2)
          tss (substr time 5 2) 

          strok1 (strcat "Имя файла:" nam "  Дата:" tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)

          strok1 (strcat "Имя файла: " nam )
          strok2 (strcat "Дата: " tday "-" tmon "-" tyer "г  " thh ":" tmm ":" tss)
      strok3 (strcat "Действие: " "Чертеж закрыт")
    )
    (write-line strok2 fp)
    (write-line strok1 fp)
    (write-line strok3 fp)
    
    (princ)
    ;(vla-SendCommand _ad "_.UNDO ")
    ;(vla-SendCommand _ad "1 ")
  ;);progn
;);if
);defun undel

Приводить к красоте не охото, так что лишнее удалите сами)

29.06.2012, 13:40		#1
Autolisp. Отчет о закрытии и открытии чертежа. Zaghim Регистрация: 01.07.2010 Сообщений: 521 Друзья, помогите сделать лисп, который сохранял бы по указанному пути время и имя пользователя, когда он открывает чертеж и когда его закрывает. В идеале было бы еще проверка, открыт чертеж или нет, например каждые 5 минут, что бы избежать проблем, когда кад аварийно закрывается.
Просмотров: 1979

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
ошибка при открытии чертежа в AutoCAD	Traum	AutoCAD	13	24.09.2011 11:50
При открытии файла чертежа в AutoCAD открывается сам чертеж + справка	nikiton21	AutoCAD	7	28.01.2010 09:45
глюк при открытии чертежа autocad "Имя открываемого рисунка"	Визуализатор	Баги и пожелания в Autodesk	1	19.11.2009 00:15