Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп: реакторы

Лисп: реакторы

Ответ
Поиск в этой теме
Непрочитано 02.03.2005, 16:14 #1
Лисп: реакторы
Torino
 
Штаб
Регистрация: 21.08.2003
Сообщений: 943

Код:
[Выделить все]
;;;Просто добавь этот файл в автозагрузку
(vl-load-com)


(setq layers (vla-get-layers
	       (vla-get-activedocument
		 (vlax-get-acad-object)
	       )
	     )
)
(setq OldLayer (getvar "CLAYER"))

(vl-cmdf "layer" "m" "размеры" "c" 151 "" "") ;Да простят меня гуру...
(vl-cmdf "layer" "m" "штриховка" "c" 5 "" "")

(setvar "clayer" OldLayer)


(vlr-command-reactor
  nil
  '((:vlr-commandWillStart . startCommand))
)
(vlr-command-reactor
  nil
  '((:vlr-commandEnded . endCommand))
)
(vlr-command-reactor
  nil
  '((:vlr-commandCancelled . cancelCommand))
)

;;;------------------------------------------------------------------
(defun startCommand (calling-reactor
		     startcommandInfo
		     /
		     thecommandstart
		    )
  (setq OldLayer (getvar "CLAYER"))
  (setq thecommandstart (nth 0 startcommandInfo))

  (cond
    ((wcmatch thecommandstart "DIM*")
     (setvar "clayer" "размеры")
    )
    ((wcmatch thecommandstart "*HATCH*")
     (setvar "clayer" "штриховка")
    )
  )
;;;  (if (wcmatch thecommandstart "DIM*")
;;;    (setvar "clayer" "размеры")
;;;  )


  (princ)
)

;;;--------------------------------------------------------------------
(defun endCommand (calling-reactor
		   endcommandInfo
		   /
		   thecommandend
		  )
  (setq thecommandend (nth 0 endcommandInfo))

  (cond
    ((wcmatch thecommandstart "DIM*")
     (setvar "clayer" OldLayer)
    )
    ((wcmatch thecommandstart "*HATCH*")
     (setvar "clayer" OldLayer)
    )
  )

;;;  (if
;;;    (wcmatch thecommandend "DIM*")
;;;     (setvar "clayer" OldLayer)
;;;  )


  (princ)
)

;;;--------------------------------------------------------------------
(defun cancelCommand (calling-reactor
		      cancelcommandInfo
		      /
		      thecommandcancel
		     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))

  (cond
    ((wcmatch thecommandstart "DIM*")
     (setvar "clayer" OldLayer)
    )
    ((wcmatch thecommandstart "*HATCH*")
     (setvar "clayer" OldLayer)
    )
  )

;;;  (if
;;;    (wcmatch thecommandcancel "DIM*")
;;;     (setvar "clayer" OldLayer)
;;;  )


  (princ)
)


(princ)
Проблема в следующем: ставлю в отладчике breakpoint на cond в функции startCommand и смотрю, что происходит при запуске команды DIMLINEAR.

При старте этой команды, управление передается функции startCommand.
Происходит проверка первого условия в cond.
Условие выполняется. Выходит из cond.
Затем выполняется princ, а потом управление передается обратно функции startCommand. И так 4 раза.
Почему так происходит?
(то же самое происходит и с функциями endCommand и cancelCommand).
Просмотров: 2364
 
Непрочитано 02.03.2005, 16:47
#2
Эдуард

строительство
 
Регистрация: 16.01.2004
Петербург
Сообщений: 165
<phrase 1=


Похоже все очень просто.
У тебя нет проверки на наличие реакторов в рисунке и во
время отладки ты создал по 4 одинаковых реактора
реагирующих на одни и те-же события одними и теми-же
функциями отклика.
Которые успешно выполняются.
Эдуард вне форума  
 
Автор темы   Непрочитано 02.03.2005, 16:51
#3
Torino


 
Регистрация: 21.08.2003
Штаб
Сообщений: 943
<phrase 1=


Точно!
Спасибо!
Torino вне форума  
 
Непрочитано 02.03.2005, 18:52
#4
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 755


Код:
[Выделить все]
;;;Просто добавь этот файл в автозагрузку 
(vl-load-com)

(setq layers   (vla-get-layers
                 (vla-get-activedocument (vlax-get-acad-object))
               )
      OldLayer (getvar "CLAYER")
)

(vl-cmdf "layer" "m" "размеры" "c" 151 "" "")
(vl-cmdf "layer" "m" "штриховка" "c" 5 "" "")

(setvar "clayer" OldLayer)

(foreach i (mapcar 'cadr (vlr-reactors :VLR-Command-Reactor))
  (if (= "MyCommandReactor" (vlr-data i))
    (vlr-remove i)
  )
)

(vlr-command-reactor
  "MyCommandReactor"
  '((:vlr-commandWillStart . startCommand)
    (:vlr-commandEnded . endCommand)
    (:vlr-commandCancelled . endCommand)
   )
)

;;;------------------------------------------------------------------ 
(defun startCommand
       (calling-reactor startcommandInfo / thecommandstart)
  (setq OldLayer        (getvar "CLAYER")
        thecommandstart (car startcommandInfo)
  )
  (cond
    ((wcmatch thecommandstart "DIM*") (setvar "clayer" "размеры"))
    ((wcmatch thecommandstart "*HATCH*") (setvar "clayer" "штриховка"))
  )
  (princ)
)

;;;-------------------------------------------------------------------- 
(defun endCommand (calling-reactor endcommandInfo)
  (and (wcmatch (car endcommandInfo) "DIM*,*HATCH*")
       (setvar "clayer" OldLayer)
  )
  (princ)
)

(princ)
P.S. Пока просматривал, Эдуард уже дал наиболее вероятный ответ, но, на всякий случай, приведу то, что сделал с кодом - минимальная оптимизация.
Alaspher вне форума  
 
Автор темы   Непрочитано 03.03.2005, 11:49
#5
Torino


 
Регистрация: 21.08.2003
Штаб
Сообщений: 943
<phrase 1=


>>Alaspher
Спасибо!
Torino вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп: реакторы

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск