прервать (command... не прерывая программу

03.11.2003, 13:05

давно на лиспе сочиняю, но вот надобности не возникло ещё...

надо двигать блок [(command "move" "0.0.0" pause)] но блин хотелось бы так, чтоб при нажатии правой мыши лисп бы не прерывался а продолжался- предлагал движение но с другой базовой точкой

насколько это просто? какие мысли есть у кого?

10.11.2003, 09:38

не пробовал ещё- с выходных пришёл только.

поработаю вот и к обеду ближе попробую.

искреннее спасибо всем за проявленное участие.

vk · 10.11.2003, 15:20

Кое что наваял...

Код:

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

(defun insch (bname ;_ имя блока для вставки
              delta ;_ список смещений вида '((0.0 0.0) (10.0 20.0) (20.0 20.0))
              /
              sc ;_ масштаб
              rot ;_ поворот
              pt ;_ точка вставки блока
              pts ;_ точка с привязкой
              bl ;_ имя блока
              resp ;_ ввод с мышки
              n ;_ номер смещения в списке
              d ;_ смещение
             )
  (setvar "cmdecho" 0)
  (setq sc 1.0)
  (setq rot 0.0)
  (setq n 0)
  (setq d (nth n delta))
  (command "_.insert" bname (cadr (grread 1)) sc sc rot)
  (setq bl (entlast))

  (while (/= (car (setq resp (grread t 4 0))) 3)
    (cond
      ((= (car resp) 5)
       (setq pt (cadr resp))
;;;       (if (setq pts (osnap pt "_end")) ; жалкая пародия на привязку
;;;         (setq pt pts)                  ; лучше не раскомментировать :-)
;;;       ) ;_  if
       (entmod (subst (cons 10 (mapcar '+ pt d)) (assoc 10 (entget bl)) (entget bl)))
      )
      ((= (car resp) 25)
       (if (= (setq n (1+ n)) (length delta))
         (setq n 0)
       ) ;_  if
       (setq d (nth n delta))           ; новое смещение точки вставки блока
      )
    ) ;_  cond
  ) ;_  while
  (setvar "cmdecho" 1)
) ;_  defun

;; пример вызова функции
(insch "MyBlock" '((0.0 0.0) (5.0 7.0) (5.0 -7.0) (-5.0 7.0) (-5.0 -7.0)))

10.11.2003, 15:37

по правой мыши код не прерывается
акад 2000

надо бы Полещука почитать, чтоль. От жизни я отстал...

10.11.2003, 15:58

mbl работает, просто 25 на 11 поменял, слегка почитав Полещука

надо помодифицировать её, конечно, но похоже что оно на первый взгляд

попробую её покрутить, подключить диалоги и т.д. ...

но как она работает- убейте не пойму. А именно- что за буквы а а а и что за (terpri), что за зверь такой?

что читать???

vk · 10.11.2003, 16:13

Вот и у меня сомнения в коде 25

Впрочем, это работает на АКАД2002. Больше не начем проверить....

TERPRI - это вроде (princ "\n")

10.11.2003, 17:51

Читал Полещука. Много думал...

grread- словами обьясните алгоритм отрисовки в динамике + считывания точных координат точки

пока моего понимания хватило на это:

Код:

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

(while (=(car(setq RES (grread T)))5)
   (command "_.insert" "bname" "s" "0.25" (cadr RES) "0")
   (entdel(entlast))
)
(if (=(car RES)3)
   (command "_.insert" "bname" "s" "0.25" RES1 "0")
)

Что дальше?

Переборов некоторое иррациональное отвращение почитал заодно про реакторы (это я с другой стороны подлезть попробовал). Подгрузил очень много реакторов, и теперь при вставке блока или просто при нажатии на правую мышь у меня в командной строке много красивых словей выскакивает.
Внимаание- вопрос! Какое событие можно повесить на нажатие правой мыши при pause в

Код:

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

(command "insert" BLOCK_NAME pause "1" "1" "0")

. :vlr-abortInsert не хочет считать это за ошибку. vlr-mouse-reactor (событие :vlr-beginRightClick) тоже не совсем то , что надо- он, зараза текущий insert как- то не прерывает.

vk · 10.11.2003, 20:00

Не знаю, как это делается "по науке", имею в виду динамику...

У меня получилось таким образом:
читаю значение с указателя (мышки)
(setq resp (grread t 4 0))
затем в соответствии с текущими координатами мышки
(setq pt (cadr resp))
меняю точку вставки блока, попутно учитывая смещение (список d)
(entmod (subst (cons 10 (mapcar '+ pt d)) (assoc 10 (entget bl)) (entget bl)))

Кстати, при использовании (entmod...) "тянучка" пропала полностью!
А вот привязки через (osnap...) работают весьма плачевно, цепляются к примитивам блока.

11.11.2003, 00:25

Ой, пойду за пивом, в ближний супермаркет. Ой 12 минут до полуночи, закроеться... Всех с днем милиции! Функции завтра добьем.

11.11.2003, 09:23

поспал, подумал в автобусе по дороге на работу... короче нечто вроде mbl наверное сделаю я, без настоящей динамики, с изменением смещения по одной мышке или окончением выбора по другой... это не совсем то, что у меня было задумано, но лучше чем сейчас (диалог).
спасибо vk и SAV, много нового узнал.

11.11.2003, 11:07

Вот вчера, для собственных нужд накарябал. Неважно что за символ вставляет эта программа. Важен принцип работы с мышью. Читайте сообщения в командной строке.

Код:

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

(defun c:acp (/ asmi_nabor do_flag neverend base_pt)
  (setvar "cmdecho" 0)
  (if (not symb_scale) (setq symb_scale 1));&Oacute;ńņąķīāźą ā&aring;ėč&divide;čķū ńčģāīėīā ļī &oacute;ģīė&divide;ąķčž
(if (equal nil (tblsearch "block" "seccad_control_panel")); if (2) Ļšīā&aring;šźą ķą ķąėč&divide;č&aring; ńīīņā&aring;ņńņā&oacute;žł&aring;ćī įėīźą ā įąē&aring; &auml;ąķķū&otilde; &divide;&aring;šņ&aring;ęą
    (progn
(setq asmi_nabor (ssadd))
(entmake; āū&divide;&aring;š&divide;čāąķč&aring; ļš˙ģī&oacute;ćīė&uuml;ķčźą
'((0 . "LWPOLYLINE")  (5 . "C0559") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0")(62 . 0) (48 . 0.5) (100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 
0.0) (38 . 0.0) (39 . 0.0) (10 -450.0 2.27374e-013) (40 . 0.0) (41 . 0.0) (42 . 
0.0) (10 -450.0 500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 450.0 500.0) (40 . 
0.0) (41 . 0.0) (42 . 0.0) (10 450.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 
-450.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
);end entmake
(ssadd (entlast) asmi_nabor);&auml;īįąāė&aring;ķč&aring; ļš˙ģī&oacute;ćīė&uuml;ķčźą ā ķąįīš

(entmake; āū&divide;&aring;š&divide;čāąķč&aring; ļīėčėčķčč
'( (0 . "LWPOLYLINE")  (5 . "C055C") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0")(62 . 0) (48 . 0.5) (100 . "AcDbPolyline") (90 . 3) (70 . 0) (43 . 
0.0) (38 . 0.0) (39 . 0.0) (10 -90.2522 500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) 
(10 -90.2522 297.013) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 -450.0 297.013) (40 
. 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
);end entmake
(ssadd (entlast) asmi_nabor);&auml;īįąāė&aring;ķč&aring; ļīėčėčķčč ā ķąįīš

(terpri)
(command "_.block" "seccad_control_panel" "0,0" asmi_nabor "");ńīē&auml;ąķč&aring; įėīźą čē żė&aring;ģ&aring;ķņīā ķąįīšą
    )
    );end of if (2)
    (princ "SECCAD -> <CONTROL PANEL>")
(terpri)
(command "_.insert" "seccad_control_panel" "_s" symb_scale pause pause);āńņąāźą įėīźą ā &divide;&aring;šņ&aring;ę
  (while (/= neverend "sdfsdfasdjfsd789")
    (terpri)
     (princ "SECCAD -> LEFT CLICK to repeat, RIGHT CLICK to Move & Rotate, ANY KEY to Exit")
    (terpri)
    (setq do_flag (car(grread nil 2 0)))
    (if (= do_flag 25)
      (progn
	(command "_.move" (entlast) "" (getpoint "SECCAD -> Specify new Base Point for Moving ") pause)
	(terpri)
	(command "_.rotate" (entlast) ""  (getpoint "SECCAD -> Specify new Base Point for Rotatation") pause)
	);end progn
      );end if
    (if (= do_flag 3)(command "_.insert" "seccad_control_panel" "_s" symb_scale pause pause))
    (princ do_flag)
    (if (and(/= do_flag 3)(/= do_flag 25)) (quit));end if
    ); end while
  (terpri)
 (princ)
  );end acp

11.11.2003, 11:10

Черт! Извините скопировал из редактора VisualLISP и шрифт пояснений стал краказябрами. Но работать будет.

11.11.2003, 11:17

Ну вот, тоже самое с нормальными шрифтами.

Код:

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

(defun c:acp (/ asmi_nabor do_flag neverend base_pt)
  (setvar "cmdecho" 0)
  (if (not symb_scale) (setq symb_scale 1));Установка величины символов по умолчанию
(if (equal nil (tblsearch "block" "seccad_control_panel")); if (2) Проверка на наличие соответствующего блока в базе данных чертежа
    (progn
(setq asmi_nabor (ssadd))
(entmake; вычерчивание прямоугольника
'((0 . "LWPOLYLINE")  (5 . "C0559") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0")(62 . 0) (48 . 0.5) (100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 
0.0) (38 . 0.0) (39 . 0.0) (10 -450.0 2.27374e-013) (40 . 0.0) (41 . 0.0) (42 . 
0.0) (10 -450.0 500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 450.0 500.0) (40 . 
0.0) (41 . 0.0) (42 . 0.0) (10 450.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 
-450.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
);end entmake
(ssadd (entlast) asmi_nabor);добавление прямоугольника в набор

(entmake; вычерчивание полилинии
'( (0 . "LWPOLYLINE")  (5 . "C055C") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "0")(62 . 0) (48 . 0.5) (100 . "AcDbPolyline") (90 . 3) (70 . 0) (43 . 
0.0) (38 . 0.0) (39 . 0.0) (10 -90.2522 500.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) 
(10 -90.2522 297.013) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 -450.0 297.013) (40 
. 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
);end entmake
(ssadd (entlast) asmi_nabor);добавление полилинии в набор

(terpri)
(command "_.block" "seccad_control_panel" "0,0" asmi_nabor "");создание блока из элементов набора
    )
    );end of if (2)
    (princ "SECCAD -> <CONTROL PANEL>")
(terpri)
(command "_.insert" "seccad_control_panel" "_s" symb_scale pause pause);вставка блока в чертеж
  (while (/= neverend "sdfsdfasdjfsd789")
    (terpri)
     (princ "SECCAD -> LEFT CLICK to repeat, RIGHT CLICK to Move & Rotate, ANY KEY to Exit")
    (terpri)
    (setq do_flag (car(grread nil 2 0)))
    (if (= do_flag 25)
      (progn
	(command "_.move" (entlast) "" (getpoint "SECCAD -> Specify new Base Point for Moving ") pause)
	(terpri)
	(command "_.rotate" (entlast) ""  (getpoint "SECCAD -> Specify new Base Point for Rotatation") pause)
	);end progn
      );end if
    (if (= do_flag 3)(command "_.insert" "seccad_control_panel" "_s" symb_scale pause pause))
    (princ do_flag)
    (if (and(/= do_flag 3)(/= do_flag 25)) (quit));end if
    ); end while
  (terpri)
 (princ)
  );end acp

vk · 17.11.2003, 08:53

Выходные не прошли даром.... Появилась мысль использовать промежуточный блок. Динамика и мышкоэкранные дела получились вроде нормально, но вот в командной строке видок как-то не очень... Не удалось скрыть сообщение об ошибке и не сразу включаются подсказки на определение масштаба, если они нужны конечно.

Код:

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

(defun insch (bname delta / shcmn cmde b ib n r_mouse mr)
  (defun r_mouse (reac pt_click) ;_ функция реактора
    (if (= (setq n (1+ n)) (length delta))
      (setq n 0)
    ) ;_  if
    (entmod (subst (cons 10 (nth n delta)) (assoc 10 ib) ib))
    (redraw)
  ) ;_  defun
  (setq shcmn (getvar "shortcutmenu"))
  (setq cmde (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setvar "shortcutmenu" 0)
  (setq n 0)
  (command "_.insert" bname '(0.0 0.0))
  (while (/= (getvar "cmdactive") 0) (command ""))
  (setq b (entlast))
  (setq mr (vlr-mouse-reactor nil '((:vlr-beginRightClick . r_mouse))))
  (command "_.block" "temporary_block" '(0.0 0.0) b "")
  (setq ib (entget (cdr (assoc -2 (tblsearch "BLOCK" "temporary_block")))))
  (princ "\nУкажите точку вставки или правый клик для смены базовой точки блока > ")
  (command "_.insert" "temporary_block" pause)
  (setvar "cmdecho" cmde)
  (setvar "shortcutmenu" shcmn)
  (vlr-remove mr)
  (while (/= (getvar "cmdactive") 0) (command pause))
  (setvar "cmdecho" 0)
  (command "_.explode" (entlast))
  (command "_.purge" "_b" "temporary_block" "_n")
  (setvar "cmdecho" cmde)
  (princ)
) ;_  defun

;; пример вызова функции
;;;(insch "blockname" '((0.0 0.0) (5.0 7.0) (5.0 -7.0) (-5.0 7.0) (-5.0 -7.0)))

03.11.2003, 13:05
прервать (command... не прерывая программу DronT Сообщений: n/a давно на лиспе сочиняю, но вот надобности не возникло ещё... надо двигать блок [(command "move" "0.0.0" pause)] но блин хотелось бы так, чтоб при нажатии правой мыши лисп бы не прерывался а продолжался- предлагал движение но с другой базовой точкой насколько это просто? какие мысли есть у кого?
Просмотров: 12038

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

	Реклама i