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

(defun C:dyn_test-1 (/ p_prev p_base p min_step ang dist p1 p2 p3 _bm
                     _ce  draw-ent)
    ;; Задаем минимальный шаг (расстояние между точками,
    ;; при превышении которого будут выполняться перерисовка
    (setq min_step 1e-6)
    (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-1)
;;создание примитива
    (entmake
        (list '(0 . "text")
              (cons 1 "00000") ;текст
              (cons 40 10) ;высота шрифта
              (cons 10 '(0 0 0))
        ) ;конец list
    )
    (setq draw-ent  (vlax-ename->vla-object (entlast))) ;(entlast)) ;
    (if dyndraw
        (progn
            (setq p
                     (dyndraw
                         "dyn_call_back-1"
                         "\nУкажите точку : "
                         nil
                         (+ 2 128)
                         -1
                         nil
                     )
            )
            (redraw)
            (if p
                (progn
                    (vla-put-insertionpoint draw-ent (vlax-3d-point p))
                    (vla-put-TextString
                        draw-ent
                        (strcat "X=" (rtos (car p)) "  Y=" (rtos (cadr p)))
                    )
;;;                    (vla-move draw-ent
;;;                              (vlax-3d-point '(0 0 0))
;;;                              (vlax-3d-point '(0 0 0))
;;;                    )
                )
            ) ;_endof if progn
        )
    )
    (setvar "blipmode" _bm)
    (setvar "cmdecho" _ce)
    (princ)
)
(defun dyn_call_back-1 (p / )
    (if (not p_prev)
 ;;;       (progn
            (setq p_prev p)
 ;;;        (vla-put-insertionpoint draw-ent (vlax-3d-point p))
 ;;;       )
    )
    (if (and (LISTp p) (> (distance p_prev p) min_step))
        (progn
 ;(redraw)
            (vla-put-insertionpoint draw-ent (vlax-3d-point p))
;;;            (vla-move draw-ent
;;;                      (vlax-3d-point p_prev)
;;;                      (vlax-3d-point p)
;;;            )
            (vla-put-TextString
                draw-ent
                (strcat "X=" (rtos (car p)) "  Y=" (rtos (cadr p)))
            )
            (vla-update draw-ent)
            (setq p_prev p)
        )
    )
    t
)

;;--------------------------------------------------------------------
;;                           (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) (list X Y Z) - точка,      если задан флаг acqurePoint
;;     2) REAL         - расстояние, если задан флаг acqureDist
;;     3) REAL         - угол,       если задан флаг acqureAngle
;;     4) STR          - ключевое слово   - если строка ключевых слов не пустая или
;;                       введенная строка - если задан флаг AcceptOtherInputString
;;
;;     Функция должна возвратить одно из следующих значений:
;;     1) nil          - завершить работу функции;
;;     2) (list X Y X) - точка - изменить текущую точку;
;;     3) (list ...)   - список аналогичный списку параметров
;;                       функции (dyndraw) для замены всех
;;                       параметров;
;;     4) 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) nil          - при аварийном звершении
;;
;;
;;
;; Особенности использования:
;; 1) callback-функция не должна использовать интерактивный ввод во
;;    всех случаях, кроме случая получения в качестве параметра
;;    ключевого слова.
;; 2) Если применятся динамическое отслеживание примитивов,
;;    содержащих в чертеже, то в callback-функции эти примитивы
;;    обязательно должны обновляться с использованием или (entupd),
;;    или (vla-Update)
;;--------------------------------------------------------------------