ObjectARX. Отслеживание и рисование (Страница 3 из 3)

(defun _kpblc-block-dyn-change-values (ent              lst
                              prop_lst
                              _kpblc-conv-vla-to-list
                              )
                              ;|
    ent    указатель на вхождение блока
    lst    список вида:
      '((<property> . <value>)
    (<property> . <value>)
    )
*    примеры вызова:
(_kpblc-block-dyn-change-values (car(entsel))'(("dist*" . 162.56) ("ang*" . 5.)))
;; Углы надо задавать в радианах!
(_kpblc-block-dyn-change-values (car (entsel)) '(("type" . "minimum")))
|;

  (defun _kpblc-conv-vla-to-list (value / res)
                              ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)

  (vl-catch-all-apply
    '(lambda ()
       (setq
         ent (cond
               (ent)
               (t (car (entsel "\nУкажите вхождение дин.блока <Отмена> : ")))
               ) ;_ end of cond
         ) ;_ end of setq
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  (if (and ent
           (setq ent (cond
                       ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                       ((= (type ent) 'vla-object) ent)
                       (t nil)
                       ) ;_ end of cond
                 ) ;_ end of setq
           (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
           (= (vla-get-isdynamicblock
                (vla-item
                  (vla-get-blocks
                    (vla-get-activedocument (vlax-get-acad-object))
                    ) ;_ end of vla-get-blocks
                  (vla-get-effectivename ent)
                  ) ;_ end of vla-item
                ) ;_ end of vla-get-isdynamicblock
              :vlax-true
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (setq
        prop_lst (vlax-safearray->list
                   (vlax-variant-value (vla-getdynamicblockproperties ent))
                   ) ;_ end of vlax-safearray->list
        ) ;_ end of setq
      (foreach item (mapcar '(lambda (a) (cons (strcase (car a)) (cdr a))) lst)
        (if (setq prop
                   (car
                     (vl-remove-if-not
                       '(lambda (x)
                          (wcmatch (strcase (vla-get-propertyname x)) (car item))
                          ) ;_ end of lambda
                       prop_lst
                       ) ;_ end of vl-remove-if-not
                     ) ;_ end of car
                  ) ;_ end of setq
          ;; Имя совпало
          (vl-catch-all-apply
            '(lambda ()
               (vla-put-value
                 prop
                 (vlax-make-variant
                   (cdr item)
                   (vlax-variant-type (vla-get-value prop))
                   ) ;_ end of vlax-make-variant
                 ) ;_ end of vla-put-value
               (vla-upd ate ent)
               ) ;_ end of lambda
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun


;;
;; А.Н.Ривилис, DynDraw\DynDraw.lsp
;; Для книги "AutoCAD: разработка приложений, настройка и адаптация"
;; (издательство "БХВ-Петербург", 2005)
;;
;;--------------------------------------------------------------------
;;                           (DynDraw) 
;;--------------------------------------------------------------------
;;
;; Вызов функции:
;;  (dyndraw
;;    <call_back>      - имя callback-функции (STR)
;;    <input_prompt>   - строка подсказки (STR)
;;    <keyword_list>   - строка ключевых слов (STR)
;;    <input_flag>     - флаг параметров ввода (INT)
;;    <cursor_type>    - вид курсора (INT)        
;;    <base_point>     - базовая точка или nil
;;  )
;;
;; Параметры и их возможные значения: 
;;
;;  1) <call_back> 
;;     Строка имени callback-функции. Функция должна быть зарегистрирована 
;;     при помощи вызова: (vl-acad-defun '<call_back>)
;;     
;;     Функция принимает один параметр. В зависимости от <input_flag>
;;     он может быть:
;;     1) (X Y Z)      - точка,      если задан флаг acqurePoint
;;     2) REAL         - расстояние, если задан флаг acqureDist
;;     3) REAL         - угол,       если задан флаг acqureAngle
;;     4) STR          - ключевое слово   - если строка ключевых слов не пустая или
;;                       введенная строка - если задан флаг AcceptOtherInputString
;;
;;     Функция должна возвратить одно из следующих значений:
;;     1) nil          - завершить работу функции;
;;     2) (X Y Z)      - точка - изменить текущую точку;
;;     3) (list ...)   - список, аналогичный списку параметров
;;                       функции dyndraw для замены всех
;;                       параметров;
;;     4) STR          - строка - используется для завершения работы
;;                       и возврата этой строки
;;     5) T            - для продолжения работы без изменения
;;                       параметров;
;;  2) <input_prompt>
;;     Обычная строка подсказки, как для всех функций getXXXX
;;
;;  3) <keyword_list>  
;;     Строка ключевых слов, как для функции initget
;;
;;  4) <input_flag>    
;;     Флаг ввода - должен быть суммой одного или
;;     нескольких из следующих значений:
;;
;;     GovernedByOrthoMode             1
;;     NullResponseAccepted            2
;;     DontEchoCancelForCtrlC          4
;;     DontUpdateLastPoint             8
;;     NoDwgLimitsChecking            16
;;     NoZeroResponseAccepted         32
;;     NoNegativeResponseAccepted     64
;;     Accept3dCoordinates           128
;;     AcceptMouseUpAsPoint          256
;;     AnyBlankTerminatesInput       512
;;     InitialBlankTerminatesInput  1024
;;     AcceptOtherInputString       2048
;;
;;     и только одного из следующих значений:
;;
;;     acqurePoint        0  -  в вызывающую функцию (и в callback) 
;;                              возвращается point - выбранная точка
;;     acqureDist      8192  -  в вызывающую функцию (и в callback) 
;;                              возвращается REAL - расстояние
;;     acqureAngle    16384  -  в вызывающую функцию (и в callback) 
;;                              возвращается REAL - угол (в радианах)
;;
;;  5) <cursor_type>
;;     Вид курсора (целое число) - одно из следующих значений:
;;     NoSpecialCursor      -1      No special cursor specified 
;;     Crosshair             0      Full screen cross hair 
;;     RectCursor            1      Rectangular cursor 
;;     RubberBand            2      Rubber band line 
;;     NotRotated            3      (AutoCAD internal use only) 
;;     TargetBox             4      Target Box type 
;;     RotatedCrosshair      5      (AutoCAD internal use only) 
;;     CrossHairNoRotate     6      Crosshairs forced non-rotated 
;;     Invisible             7      Invisible cursor 
;;     EntitySelect          8      Entity selection target cursor 
;;     Parallelogram         9      Parallelogram cursor 
;;     EntitySelectNoPersp  10      Pickbox, suppressed in persp 
;;     PkfirstOrGrips       11      Auto-select cursor 
;;
;;  6) <base_point>
;;     Базовая точка или nil - если берется текущее положение курсора.
;;
;; Функция может вернуть одно из следующих значений:
;;     1) (list X Y Z) - точка,      если задан флаг acqurePoint
;;     2) REAL         - расстояние, если задан флаг acqureDist
;;     3) REAL         - угол,       если задан флаг acqureAngle
;;     4) STR          - строка,     если callback-функция вернула
;;                              эту строку
;;     5) nil          - при аварийном звершении
;;
;; Особенности использования и замечания:
;; 1) callback-функция не должна использовать интерактивный ввод во
;;    всех случаях, кроме случая получения в качестве параметра
;;    ключевого слова.
;; 2) Если применятся динамическое отслеживание примитивов,
;;    содержащихся в чертеже, то в callback-функции эти примитивы
;;    обязательно должны обновляться с использованием или entupd,
;;    или vla-Update. Я бы не рекомендовал использовать vla- и 
;;    vlax- функции внутри callback-функции.
;; 3) Если применяется рисование при помощи grdraw или grvecs,
;;    не забывайте выполнять (redraw) для очистки экрана.
;; 4) Для корректного восстановления формы курсора после
;;    окончания работы основной функции вставьте где-нибудь в тело
;;    основной функции, после всех вызовов dyndraw следующую строку:
;;    (command "_.Redraw") или окаймить кусок кода 
;;    (command "_.Undo" "_Begin") и (command "_.Undo" "_End")
;; 5) Внутри callback функции можно переопределить все параметры,
;;    переданные в функцию dyndraw, в том числе и имя самой callback-
;;    функции, что позволяет иметь несколько callback-функций для 
;;    обработки различных ситуаций, ключевых слов и т.д.
;;--------------------------------------------------------------------

;;--------------------------------------------------------------------
;;      Тестовая программа для проверки работы функции DynDraw
;;--------------------------------------------------------------------
(defun C:DYN_TEST ( / p_prev p_base p min_step 
                      ang dist p1 p2 p3 _bm _ce
                  )
  (setq ent (cdr (assoc -1 (entget (car (entsel))))))
  ;; Задаем минимальный шаг (расстояние между точками),
  ;; при превышении которого будут выполняться перерисовка
  (setq min_step 1e-6) 
  ;; Если arx-файл еще не загружен - загрузим его
  ;; Очевидно, что он должен находится в путях доступа
  ;; AutoCAD в текущем профиле
  (if (null dyndraw) (progn
    (arxload "dyndraw.arx")
  )) ;_endof if progn 
  ;; Подавляем BLIPMODE - чтобы polar не тормозил
  (setq _bm (getvar "blipmode") _ce (getvar "cmdecho")) 
  (setvar "blipmode" 0) (setvar "cmdecho" 0)
  ;; Регистрируем функцию для вызова из ObjectARX
  ;; Это обязательная процедура!!!
  (vl-acad-defun 'dyn_call_back) 

  (setq p (getvar "LASTPOINT"))
  
  (while 
    (and dyndraw p (/= (type p) 'STR)
         (setq p (getpoint "\nУкажите базовую точку (ENTER - завершение): ")))
    (setq p_base p p_prev p)
    (setq p 
      (dyndraw 
         ;; Имя callback - функции
         "dyn_call_back"
         ;; Строка подсказка
         "\nУкажите точку [Базовая точка]: "
         ;; Строка ключевых слов
         "Б B _ B B" ;; Такой вид записи используется, чтобы дать
                     ;; возможность вводить глобальные ключевые
                     ;; слова без подчеркивания
         ;; Управление вводом 
         (+ 2 128) ;; Разрешим пустой ввод и 3D-точки
         ;; Управление видом курсора 
         2 ;;  Резиновая линия
         ;; Базовая точка (в UCS)
         p
      )
    )
    (redraw)
    
    (if (= (type p) 'LIST) (progn
      ;; Настало время добавить полученный квадрат в чертеж!
      (setq ang   (angle p_base p)
            dist  (* (distance p_base p) (sqrt 2))
            p1    (polar p (+ ang (* pi 0.75)) dist)
            p2    (polar p1 (+ ang (* pi 1.25)) dist)
            p3    (polar p2 (+ ang (* pi 1.75)) dist)
      )
      (command "_.undo" "_begin")
      (command "_.pline" "_none" p "_w" 0 0 "_none" p1  "_none" p2  "_none" p3 "_c")
      (command "_.undo" "_end")
    )) ;_endof if progn 
  ) ;_endof while  
  (if (= (type p) 'STR)
    (princ (strcat "\nПользователь ввел строку: <" p ">"))
  ) 

  (setvar "blipmode" _bm) (setvar "cmdecho" _ce)
  (princ)
) ;_endof defun 
;;--------------------------------------------------------------------
;;               Пример callback-функции
;; 1. Функция вызывается с одним параметром, который может быть или
;;    точкой в UCS, или ключевым словом. Если в списке ключевых
;;    слов присутствует "_", то передается глобальное ключевое слово
;; 2. Возврат nil в вызывающей ее функции воспринимается, как признак
;;    завершения работы, и вызывающая функция тоже вернет nil
;; 3. Возврат в вызывающую функцию точки, которая отлична от 
;;    переданной воспринимается, как изменение базовой точки.
;; 4. Возврат в вызывающую функцию списка, который аналогичен 
;;    списку параметров функции dyndraw, приводит к изменению
;;    всех параметров работы. В том числе можно изменить и имя 
;;    callback-функции,
;;--------------------------------------------------------------------
(defun dyn_call_back (p / p1 p2 p3)
 (cond
  ((= (type p) 'STR) ;; Выбрано ключевое слово
    (redraw) ;; Чистим мусор на экране
    (cond 
     ((= p "B") ;; Запрос базовой точки
      (if (setq p (getpoint p_base "\nУкажите новую базовую точку: "))
        (setq p_base p
              p  (list 
                  "dyn_call_back" 
                  "\nУкажите новую точку: "
                  "" ;; Запретим ключевые слова
                  (+ 2 128) ;; Разрешим пустой ввод и 3D-точки
                  2 ; Резиновая линия
                  p
                 )
         )
      ) 
     )
     (T
      ;; Вернем эту строку
      (princ (strcat "\nНеизвестное ключевое слово <" p ">!!!"))
     )
    ) ;_endof cond 
  )
  ((= (type p) 'LIST) ;; Отслеживание по точке
    (if (null p_base) (setq p_base p p_prev p)) 
    (if (and p_prev (> (distance p_prev p) min_step)) (progn
      (setq p_prev p) 
      (se tq input p
            ang   (angle p_base p)
            dist  (* (distance p_base input) (sqrt 2))
            p1    (polar input (+ ang (* pi 0.75)) dist)
            p2    (polar p1 (+ ang (* pi 1.25)) dist)
            p3    (polar p2 (+ ang (* pi 1.75)) dist)
       )

      (_kpblc-block-dyn-change-values ent (list (cons "Distance" (distance p_base input)) (cons "angle" (angle p_base input))))
    );progn
      );if
  )
 ) ;_endof cond 
 p
) ;_endof defun