Связь графических объектов и текста (Страница 2 из 4)

CB

CB
Восстановленный участник

На форуме с 17 мая 2006г.
Сообщений: 212
Спасибо: 0

Re: Связь графических объектов и текста

> [Re:] Electr
И это не сложно, просто я сейчас нескольно занят по работе... Если только попозже...

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

Договорились. Ждать мы умеем

CB

CB
Восстановленный участник

На форуме с 17 мая 2006г.
Сообщений: 212
Спасибо: 0

Re: Связь графических объектов и текста

> [Re:] Electr
Где-то так...

(defun react-test (/ name-line name-txt line-reactor)
  (vl-load-com)
  (setq    lst-name-line
     (mapcar 'vlax-ename->vla-object
         (vl-remove-if
           'listp
           (mapcar (function cadr)
               (ssnamex (ssget '((0 . "*Line"))))
           ) ;_ end of mapcar
         ) ;_ end of vl-remove-if
     ) ;_ end of mapcar
  ) ;_ end of setq
  (setq    name-txt (vlax-ename->vla-object
           (car (entsel "\nВыберите текст: "))
         ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vla-put-TextString
    name-txt
    (rtos (apply '+ (mapcar 'vla-get-Length lst-name-line)) 2 2)
  ) ;_ end of vla-put-TextString
  (setq    line-reactor
     (vlr-object-reactor
       lst-name-line
       (list name-txt)
       (list '(:vlr-modified . len))
     ) ;_ end of vlr-object-reactor
  ) ;_ end of setq
  (vlr-pers line-reactor)
) ;_ end of defun
(defun len (L txt arg /)
  (vla-put-TextString
    (car (vlr-data txt))
    (rtos
      (apply '+
         (mapcar 'vla-get-Length (vlr-owners (car (vlr-pers-list))))
      ) ;_ end of apply
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
) ;_ end of defun
;;;(react-test)

CB

CB
Восстановленный участник

На форуме с 17 мая 2006г.
Сообщений: 212
Спасибо: 0

Re: Связь графических объектов и текста

Так будет правильней. Будет считать и полилинии...

(defun react-test (/ name-line name-txt line-reactor)
  (vl-load-com)
  (prompt "\nВыберите линии и полилинии: ")
  (setq    lst-name-line
     (mapcar 'vlax-ename->vla-object
         (vl-remove-if
           'listp
           (mapcar (function cadr)
               (ssnamex (ssget '((0 . "*Line"))))
           ) ;_ end of mapcar
         ) ;_ end of vl-remove-if
     ) ;_ end of mapcar
  ) ;_ end of setq
  (setq    name-txt (vlax-ename->vla-object
           (car (entsel "\nВыберите текст: "))
         ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vla-put-TextString
    name-txt
    (rtos (apply '+
         (mapcar '(lambda (x)
                (vlax-curve-getDistAtParam
                  x
                  (vlax-curve-getEndParam x)
                ) ;_ end of vlax-curve-getDistAtParam
              ) ;_ end of lambda
             lst-name-line
         ) ;_ end of mapcar
      ) ;_ end of apply
      2
      2
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
  (setq    line-reactor
     (vlr-object-reactor
       lst-name-line
       (list name-txt)
       (list '(:vlr-modified . len))
     ) ;_ end of vlr-object-reactor
  ) ;_ end of setq
  (vlr-pers line-reactor)
) ;_ end of defun
(defun len (L txt arg /)
  (vla-put-TextString
    (car (vlr-data txt))
    (rtos
      (apply '+
         (mapcar '(lambda (x)
            (vlax-curve-getDistAtParam
              x
              (vlax-curve-getEndParam x)
            ) ;_ end of vlax-curve-getDistAtParam
              ) ;_ end of lambda
             (vlr-owners (car (vlr-pers-list)))
         ) ;_ end of mapcar
      ) ;_ end of apply
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
) ;_ end of defun
;;;(react-test)

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

Вот это тема. Вот то что нужно. Спасибо большое. Только подскажите что исправить в программе чтобы длина измерялась в метрах

CB

CB
Восстановленный участник

На форуме с 17 мая 2006г.
Сообщений: 212
Спасибо: 0

Re: Связь графических объектов и текста

> [Re:] Electr
На самом деле это еще далеко не программа - только один из путей решения задачи... Попробуй создать пару-тройку наборов - будет считать что попало... Или удалить линию или текст свяэанных с реактором или "промазать" по тексту, не выбрать линии, нажать Esc, убрать или добавить в набор линии и т.д.

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

> Electr
А как же спецификация-то?

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

> CB
В любом случае начало положено, пока будем стараться попадать по тексту, и не удалять линии.

> Владимир Громов
А если вставить этот текст в спецификацию, то автоматически будет изменяться длина линий, чего мы и добивались. Я так полагаю в дальнейшем эти наработки можно будет подправить для подсчета количесва блоков.

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

Интересной может оказаться программа на основе сделанной СВ, но в которой отрисовывался бы отрезок или полилиния (а не выбирались бы предварительно отрисованные) и после указания точки на экране в это место вставлялся бы текст с начальной длиной (а не выбирался бы предварительно вставленный текст).

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

> Electr
Немного доработал код CB. Теперь можно промахиваться по тексту, иметь в чертеже пару-тройку наборов, удалять безнаказанно линии + еще кое-какие команды

(vl-load-com)
(defun LinerViz ( reac en / lst ss)
  (and
    (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
    (if en (setq ss (ssadd en))(setq ss (ssadd)))
    (mapcar '(lambda(x)(ssadd (vlax-vla-object->ename x) ss)) lst)
    (SSSETFIRST ss ss)
    )
  )
(defun C:LineRViz ( /  name-txt reac)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
       (LinerViz reac name-txt)
   )
  (princ)
  )
(defun sumlst ( objText lst )
  (if (vlax-write-enabled-p objText)
    (vla-put-TextString objText
    (rtos (apply '+ (mapcar '(lambda (x)
                               (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x)))
                            lst) ;_ end of mapcar
                 ) ;_ end of apply
    2 ;_Десятичная  система
    2 ;_Точность округления
    ) ;_ end of rtos
      )
   (princ "\n*** Text заблокирован ***")
  )
  )
(defun C:LineRAdd ( /  name-txt reac lst ss )
  (and (or (SSSETFIRST) t)
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для добавления к реактору")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-add reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
       (sumlst (vlax-ename->vla-object name-txt) lst)
   )
  (princ)
  )
(defun C:LineRDel ( /  name-txt reac lst ss )
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для удаления из реактора")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
       (sumlst (vlax-ename->vla-object name-txt) lst)
   )
  (setq ss nil)
  (princ)
  )
(defun C:LineRDestroy ( /  name-txt reac lst)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (or (initget "Yes No") t)
        (= (getkword "\nУдалять реактор [Yes/No] <No>:") "Yes")
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
   )
  (princ)
  )
(defun C:LineR ( / name-line name-txt line-reactor obj)
  (vl-load-com)
  (prompt "\nВыберите линии, полилинии, окружности и дуги, элипсы: ")
(if
  (and
  (setq lst-name-line (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
  (setq  lst-name-line (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex lst-name-line))))) ;_ end of setq
  (setq name-txt (car (entsel "\nВыберите текст: ")))
  (if (apply 'or
  (mapcar '(lambda(r)
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             )
             (vlr-pers-list)
          )
             )
    (progn (alert "\n*** Текст уже занят реактором ***") nil)
    t)
  (setq  obj (vlax-ename->vla-object name-txt)) ;_ end of setq
  )
  (progn
  (vla-put-TextString
    obj
    (rtos (apply '+
     (mapcar '(lambda (x)
          (vlax-curve-getDistAtParam
            x
            (vlax-curve-getEndParam x)
          ) ;_ end of vlax-curve-getDistAtParam
        ) ;_ end of lambda
       lst-name-line
     ) ;_ end of mapcar
    ) ;_ end of apply
    2 ;_Десятичная  система
    2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
  (setq  line-reactor
   (vlr-object-reactor
     lst-name-line
     (list "LineR" (cdr(assoc 5 (entget name-txt))))
     (list '(:vlr-modified . len)
           '(:vlr-erased . len)
           )
   ) ;_ end of vlr-object-reactor
  ) ;_ end of setq
  (vlr-pers line-reactor)
  )
  )
  (princ)
) ;_ end of defun
(defun len (vlao reac arg / lst dat txt)
  (if
  (and (vlr-added-p reac) ;_Не деактивирован реактор
    (member vlao (setq lst (vlr-owners reac))) ;_Не исключен объет из реактора
        (= (car (setq dat (vlr-data reac))) "LineR")
    )
  (progn
    (if (and (setq txt (cadr dat))
             (setq txt (handent txt))
             (entget txt)
             )
      (if (and (setq txt (vlax-ename->vla-object txt))
               (vlax-write-enabled-p txt)
               )
        (vla-put-TextString txt
    (rtos
      (apply '+
       (mapcar '(lambda (x)
                  (if (vlax-erased-p x)
                    (progn (VLR-Owner-Remove reac x) 0)
      (vlax-curve-getDistAtParam
        x
        (vlax-curve-getEndParam x)
      ) ;_ end of vlax-curve-getDistAtParam
                    )
          ) ;_ end of lambda
         lst
       ) ;_ end of mapcar
      ) ;_ end of apply
      2 ;_Десятичная  система
      2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
        (princ "\n*** Text заблокирован ***")
        )
      (progn ;_Нет текста уничтожаем реактор
        (princ "\n*** Text отсутствует ***")
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
        )
      )
  )
  )
) ;_ end of defun
(princ "\nКоманды:")
(princ "\nLineR - создание реактора")
(princ "\nLineRVIZ - визуализация реактора")
(princ "\nLineRADD - добавление объекта к реактору")
(princ "\nLineRDEL - удаление объекта из реактора")
(princ "\nLineRDestroy - удаление ректора")

> Владимир Громов
Отрисовать полилинию (отрезок), вставить текст с длинной. Но тогда нет смысла городить реактор, достаточно вставить поле.
Если я правильно понял задачу, то рисуем полилинию(отрезок), после завершения команды на курсоре болтается текст заданной высоты и стиля и ждет когда его поставят на местро?

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

А можно еще масштабный коэффициент добавить?

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

Только при удалении реактора появляется следующее:
Invalid option keyword.

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

> VVA
Да, предпосылка такая. Однако вставленный текст должен меняться при изменении длины связанного отрезка (полилинии). Не хочется сначала что-то отрисовывать и писать, а потом устанавливать связь.

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

Я и сам попробовал модифицировать код СВ, использовав функцию "command", но программа работает неустойчиво.
Кусочек кода:

(defun C:react-test (/ name-line name-txt line-reactor)
  (vl-load-com)
      (command "_LINE")
(while (/= (logand (getvar "cmdactive") 31) 0)
      (command pause)
)
  (setq  lst-name-line
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if
       'listp
       (mapcar (function cadr)
         (ssnamex (ssget "_L"))
       ) ;_ end of mapcar
     ) ;_ end of vl-remove-if
   ) ;_ end of mapcar
  ) ;_ end of setq
  (command "_text" pause "" "" "1")
    (setq  name-txt (vlax-ename->vla-object
       (ssname (ssget "_L") 0)
     ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

kpblc

kpblc
Активный участник

Откуда: С.-Петербург
На форуме с 29 ноября 2004г.
Сообщений: 8,348
Спасибо: 23

Re: Связь графических объектов и текста

> Владимир Громов
В реакторах нельзя применять командные и интерактивные методы.

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

> Владимир Громов
Еще хочу уточнить: нужен реактор или подойдет поле

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

Поле не изменяет значение при изменении длины, только после regen

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

> Electr
С маштабным коэффициентом

(vl-load-com)
(defun LinerViz ( reac en / lst ss)
  (and
    (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
    (if en (setq ss (ssadd en))(setq ss (ssadd)))
    (mapcar '(lambda(x)(ssadd (vlax-vla-object->ename x) ss)) lst)
    (SSSETFIRST ss ss)
    )
  )
(defun C:LineRViz ( /  name-txt reac)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
       (LinerViz reac name-txt)
   )
  (princ)
  )
(defun sumlst ( objText lst )
  (if (vlax-write-enabled-p objText)
    (vla-put-TextString objText
    (rtos (apply '+ (mapcar '(lambda (x)
                               (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x)))
                            lst) ;_ end of mapcar
                 ) ;_ end of apply
    2 ;_Десятичная  система
    2 ;_Точность округления
    ) ;_ end of rtos
      )
   (princ "\n*** Text заблокирован ***")
  )
  )
(defun C:LineRAdd ( /  name-txt reac lst ss )
  (and (or (SSSETFIRST) t)
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для добавления к реактору")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-add reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
       (sumlst (vlax-ename->vla-object name-txt) lst)
   )
  (princ)
  )
(defun C:LineRDel ( /  name-txt reac lst ss )
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для удаления из реактора")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
       (sumlst (vlax-ename->vla-object name-txt) lst)
   )
  (setq ss nil)
  (princ)
  )
(defun C:LineRDestroy ( /  name-txt reac lst)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (or (initget "Yes No") t)
        (= (getkword "\nУдалять реактор [Yes/No] <No>:") "Yes")
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
   )
  (princ)
  )
(defun C:LineR ( / name-line name-txt line-reactor obj MM)
  (vl-load-com)
  (initget 7)
  (setq MM (getdist "\nУкажите масштабный коэффициент: "))
  (prompt "\nВыберите линии, полилинии, окружности и дуги, элипсы: ")
(if
  (and
  (setq lst-name-line (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
  (setq  lst-name-line (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex lst-name-line))))) ;_ end of setq
  (setq name-txt (car (entsel "\nВыберите текст: ")))
  (if (apply 'or
  (mapcar '(lambda(r)
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             )
             (vlr-pers-list)
          )
             )
    (progn (alert "\n*** Текст уже занят реактором ***") nil)
    t)
  (setq  obj (vlax-ename->vla-object name-txt)) ;_ end of setq
  )
  (progn
  (vla-put-TextString
    obj
    (rtos (* MM (apply '+
     (mapcar '(lambda (x)
          (vlax-curve-getDistAtParam
            x
            (vlax-curve-getEndParam x)
          ) ;_ end of vlax-curve-getDistAtParam
        ) ;_ end of lambda
       lst-name-line
     ) ;_ end of mapcar
    ) ;_ end of apply
             )
    2 ;_Десятичная  система
    2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
  (setq  line-reactor
   (vlr-object-reactor
     lst-name-line
     (list "LineR" (cdr(assoc 5 (entget name-txt))) MM)
     (list '(:vlr-modified . len)
           '(:vlr-erased . len)
           )
   ) ;_ end of vlr-object-reactor
  ) ;_ end of setq
  (vlr-pers line-reactor)
  )
  )
  (princ)
) ;_ end of defun
(defun len (vlao reac arg / lst dat txt MM)
  (if
  (and (vlr-added-p reac) ;_Не деактивирован реактор
    (member vlao (setq lst (vlr-owners reac))) ;_Не исключен объет из реактора
        (= (car (setq dat (vlr-data reac))) "LineR")
    )
  (progn
    (if (not (numberp(setq MM (caddr dat))))(setq MM 1))
    (if (and (setq txt (cadr dat))
             (setq txt (handent txt))
             (entget txt)
             )
      (if (and (setq txt (vlax-ename->vla-object txt))
               (vlax-write-enabled-p txt)
               )
        (vla-put-TextString txt
    (rtos (* MM
      (apply '+
       (mapcar '(lambda (x)
                  (if (vlax-erased-p x)
                    (progn (VLR-Owner-Remove reac x) 0)
      (vlax-curve-getDistAtParam
        x
        (vlax-curve-getEndParam x)
      ) ;_ end of vlax-curve-getDistAtParam
                    )
          ) ;_ end of lambda
         lst
       ) ;_ end of mapcar
      ) ;_ end of apply
             )
      2 ;_Десятичная  система
      2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
        (princ "\n*** Text заблокирован ***")
        )
      (progn ;_Нет текста уничтожаем реактор
        (princ "\n*** Text отсутствует ***")
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
        )
      )
  )
  )
) ;_ end of defun
(princ "\nКоманды:")
(princ "\nLineR - создание реактора")
(princ "\nLineRVIZ - визуализация реактора")
(princ "\nLineRADD - добавление объекта к реактору")
(princ "\nLineRDEL - удаление объекта из реактору")
(princ "\nLineRDestroy - удаление ректора")
;;;(react-test)

> Electr
В LineRDestroy нужно отвечать Y или N

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

> Electr
А так же
_updatefield, Открытие, созранение, печать, формирование комплекта.
Считаю вполне достаточно

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

> Алексей aka kpblc
Понятно.

> VVA
А можно программно приписать поле отрезку? И приписать программно поле ячейке таблицы со ссылкой на отрезок? Я пока не разобрался с этим. Нет опций у команды "_field".
Для Electr.
Реген, или обновить поля - это не страшно.

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

С масштабом поторопился, не везде изменил
Теперь надеюсь везде

(vl-load-com)
(defun LinerViz ( reac en / lst ss)
  (and
    (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
    (if en (setq ss (ssadd en))(setq ss (ssadd)))
    (mapcar '(lambda(x)(ssadd (vlax-vla-object->ename x) ss)) lst)
    (SSSETFIRST ss ss)
    )
  )
(defun C:LineRViz ( /  name-txt reac)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
       (LinerViz reac name-txt)
   )
  (princ)
  )
;;;(defun sumlst ( objText lst MM )
;;;  (if (vlax-write-enabled-p objText)
;;;    (vla-put-TextString objText
;;;    (rtos (* MM (apply '+ (mapcar '(lambda (x)
;;;                               (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x)))
;;;                            lst) ;_ end of mapcar
;;;                 ) ;_ end of apply
;;;             )
;;;    2 ;_Десятичная  система
;;;    2 ;_Точность округления
;;;    ) ;_ end of rtos
;;;      )
;;;   (princ "\n*** Text заблокирован ***")
;;;  )
;;;  )
(defun C:LineRAdd ( /  name-txt reac lst ss MM)
  (and (or (SSSETFIRST) t)
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для добавления к реактору")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-add reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (len (car lst) reac nil)
;;;      (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
;;;       (if (not (numberp(setq MM (caddr (vlr-data reac)))))(setq MM 1))
;;;       (sumlst (vlax-ename->vla-object name-txt) lst MM)
   )
  (princ)
  )
(defun C:LineRDel ( /  name-txt reac lst ss )
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (princ "\nВыберите объекты для удаления из реактора")
        (setq ss nil ss (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (setq  lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex ss))))) ;_ end of setq
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (len (car lst) reac nil)
  ;;;      (sumlst (vlax-ename->vla-object name-txt) lst)
   )
  (setq ss nil)
  (princ)
  )
(defun C:LineRDestroy ( /  name-txt reac lst)
  (and
       (setq name-txt (car (entsel "\nВыберите текст: ")))
       (mapcar '(lambda(r)
             (if
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             (setq reac r) nil)
             )
             (vlr-pers-list)
          )
         reac
        (setq lst (vl-remove-if 'vlax-erased-p (vlr-owners reac)))
        (mapcar '(lambda(x)(vla-Highlight x :vlax-true))(cons (vlax-ename->vla-object name-txt) lst))
        (or (initget "Yes No") t)
        (= (getkword "\nУдалять реактор [Yes/No] <No>:") "Yes")
        (mapcar '(lambda(x)(vla-Highlight x :vlax-false))(cons (vlax-ename->vla-object name-txt) lst))
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
   )
  (princ)
  )
(defun C:LineR ( / name-line name-txt line-reactor obj MM)
  (vl-load-com)
  (initget 7)
  (setq MM (getdist "\nУкажите масштабный коэффициент: "))
  (prompt "\nВыберите линии, полилинии, окружности и дуги, элипсы: ")
(if
  (and
  (setq lst-name-line (ssget '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,CIRCLE"))))
  (setq  lst-name-line (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar (function cadr)
                        (ssnamex lst-name-line))))) ;_ end of setq
  (setq name-txt (car (entsel "\nВыберите текст: ")))
  (if (apply 'or
  (mapcar '(lambda(r)
             (and (vlr-added-p r)
                  (= (cadr (vlr-data r))(cdr(assoc 5 (entget name-txt))))
                  )
             )
             (vlr-pers-list)
          )
             )
    (progn (alert "\n*** Текст уже занят реактором ***") nil)
    t)
  (setq  obj (vlax-ename->vla-object name-txt)) ;_ end of setq
  )
  (progn
  (vla-put-TextString
    obj
    (rtos (* MM (apply '+
     (mapcar '(lambda (x)
          (vlax-curve-getDistAtParam
            x
            (vlax-curve-getEndParam x)
          ) ;_ end of vlax-curve-getDistAtParam
        ) ;_ end of lambda
       lst-name-line
     ) ;_ end of mapcar
    ) ;_ end of apply
             )
    2 ;_Десятичная  система
    2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
  (setq  line-reactor
   (vlr-object-reactor
     lst-name-line
     (list "LineR" (cdr(assoc 5 (entget name-txt))) MM)
     (list '(:vlr-modified . len)
           '(:vlr-erased . len)
           )
   ) ;_ end of vlr-object-reactor
  ) ;_ end of setq
  (vlr-pers line-reactor)
  )
  )
  (princ)
) ;_ end of defun
(defun len (vlao reac arg / lst dat txt MM)
  (if
  (and (vlr-added-p reac) ;_Не деактивирован реактор
    (member vlao (setq lst (vlr-owners reac))) ;_Не исключен объет из реактора
        (= (car (setq dat (vlr-data reac))) "LineR")
    )
  (progn
    (if (not (numberp(setq MM (caddr dat))))(setq MM 1))
    (if (and (setq txt (cadr dat))
             (setq txt (handent txt))
             (entget txt)
             )
      (if (and (setq txt (vlax-ename->vla-object txt))
               (vlax-write-enabled-p txt)
               )
        (vla-put-TextString txt
    (rtos (* MM
      (apply '+
       (mapcar '(lambda (x)
                  (if (vlax-erased-p x)
                    (progn (VLR-Owner-Remove reac x) 0)
      (vlax-curve-getDistAtParam
        x
        (vlax-curve-getEndParam x)
      ) ;_ end of vlax-curve-getDistAtParam
                    )
          ) ;_ end of lambda
         lst
       ) ;_ end of mapcar
      ) ;_ end of apply
             )
      2 ;_Десятичная  система
      2 ;_Точность округления
    ) ;_ end of rtos
  ) ;_ end of vla-put-TextString
        (princ "\n*** Text заблокирован ***")
        )
      (progn ;_Нет текста уничтожаем реактор
        (princ "\n*** Text отсутствует ***")
        (mapcar '(lambda(x)(VLR-Owner-Remove reac x)) lst)
        (vlr-pers-release reac)
        (vlr-remove reac)
        )
      )
  )
  )
) ;_ end of defun
(princ "\nКоманды:")
(princ "\nLineR - создание реактора")
(princ "\nLineRVIZ - визуализация реактора")
(princ "\nLineRADD - добавление объекта к реактору")
(princ "\nLineRDEL - удаление объекта из реактору")
(princ "\nLineRDestroy - удаление ректора")
;;;(react-test)

Владимир Громов пишет:

А можно программно приписать поле отрезку?

Можно

И приписать программно поле ячейке таблицы со ссылкой на отрезок?

Можно
Если устраивает поле, то чуть попозже попробую наваять что-нибуть, только наверное в другой теме. Или эта подходит?

Electr

Electr
Активный участник

Откуда: Киргизстан / Биш
На форуме с 6 августа 2007г.
Сообщений: 241
Спасибо: 2

Re: Связь графических объектов и текста

Давайте уже в этой теме останемся, очень уж интересно получается

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

Я тоже думаю, что можно остаться в этой теме. Название темы как нельзя подходит.

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Связь графических объектов и текста

Первый набросок: рисум отрезок или полилинию (из отрезков возмется последний нарисованный)
после завершения отрисовки на курсоре болтается текст со ссылкой на длинну примитива.

;_darw Line & Polyline
(defun drawLP ( cmdname )
  (setvar "CMDECHO" 1)
  (command cmdname)
  (while (> (getvar "CMDACTIVE") 0)(command pause))
  (entlast)
  )
;_Draw Line and Insert Text
(defun C:DLIT ( / en what cmdname fld txt fc)
  (vl-load-com)
  (initget "Line Polyline")
  (and
  (if (= (getkword "Рисовать [Line/Polyline] <Polyline>: ") "Line")
    (setq cmdname "_.Line")(setq cmdname "_.PLine"))
  (setq en (drawLP cmdname))
  (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%pr2\">%"
                ) ;_ strcat
          ) ;_ setq
  (setq txt (entmakex
      (list
        (cons 0 "TEXT")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbText")
        (cons 72 0)           ;_ выравнивание влево
        (cons 1 fld)
        ;(cons 7 style) ;_Текущий стиль
        ;(cons 8 layer) ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 40 (getvar "TEXTSIZE")) ;_Текущей высотой текста
        ) ;_ list
      ) ;_ entmakex
          )
  (setvar "cmdecho" 0)
  (vl-cmdf "_updatefield" txt "")
  (princ "\n Укажите точку вставки текста:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" pause)
  (setq txt (entlast))
  (setq txt (vlax-ename->vla-object txt))
  (vlax-write-enabled-p txt)
  (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
  (vlax-property-available-p txt 'TextString)
  (setq fc (vlax-invoke txt 'FieldCode))
  (setq fc fld)
  (vlax-put txt 'TextString fc)
  )
  (princ)
  )

Владимир Громов

Владимир Громов
Активный участник

На форуме с 10 июля 2004г.
Сообщений: 8,349
Спасибо: 4

Re: Связь графических объектов и текста

> VVA
Спасибо, Владимир.
Хоть и первый набросок, но работает хорошо. Мне нравится. Я бы отправил эту программу в раздел "Готовые программы", если только у вас нет соображений по улучшению. А почему вы закоментарили две строки? Хотели как-то еще учесть стиль и слой?

Связь графических объектов и текста (Страница 2 из 4)

Сообщения с 26 по 50 из 80

#26 Ответ от CB 18 сентября 2007г. 14:33:06

Re: Связь графических объектов и текста

#27 Ответ от Electr 18 сентября 2007г. 14:50:28

Re: Связь графических объектов и текста

#28 Ответ от CB 18 сентября 2007г. 15:33:43

Re: Связь графических объектов и текста

#29 Ответ от CB 18 сентября 2007г. 16:34:58

Re: Связь графических объектов и текста

#30 Ответ от Electr 19 сентября 2007г. 07:06:57

Re: Связь графических объектов и текста

#31 Ответ от CB 19 сентября 2007г. 08:40:34

Re: Связь графических объектов и текста

#32 Ответ от Владимир Громов 19 сентября 2007г. 08:45:12

Re: Связь графических объектов и текста

#33 Ответ от Electr 19 сентября 2007г. 08:57:42

Re: Связь графических объектов и текста

#34 Ответ от Владимир Громов 19 сентября 2007г. 11:17:16

Re: Связь графических объектов и текста

#35 Ответ от VVA 19 сентября 2007г. 11:58:36

Re: Связь графических объектов и текста

#36 Ответ от Electr 19 сентября 2007г. 12:10:26

Re: Связь графических объектов и текста

#37 Ответ от Electr 19 сентября 2007г. 12:13:27

Re: Связь графических объектов и текста

#38 Ответ от Владимир Громов 19 сентября 2007г. 12:15:26

Re: Связь графических объектов и текста

#39 Ответ от Владимир Громов 19 сентября 2007г. 12:21:16

Re: Связь графических объектов и текста

#40 Ответ от kpblc 19 сентября 2007г. 12:31:26

Re: Связь графических объектов и текста

#41 Ответ от VVA 19 сентября 2007г. 12:39:43

Re: Связь графических объектов и текста

#42 Ответ от Electr 19 сентября 2007г. 12:47:14

Re: Связь графических объектов и текста

#43 Ответ от VVA 19 сентября 2007г. 12:48:53

Re: Связь графических объектов и текста

#44 Ответ от VVA 19 сентября 2007г. 12:52:13

Re: Связь графических объектов и текста

#45 Ответ от Владимир Громов 19 сентября 2007г. 12:53:37

Re: Связь графических объектов и текста

#46 Ответ от VVA 19 сентября 2007г. 13:08:42

Re: Связь графических объектов и текста

#47 Ответ от Electr 19 сентября 2007г. 13:43:56

Re: Связь графических объектов и текста

#48 Ответ от Владимир Громов 19 сентября 2007г. 13:50:46

Re: Связь графических объектов и текста

#49 Ответ от VVA 19 сентября 2007г. 15:34:35

Re: Связь графических объектов и текста

#50 Ответ от Владимир Громов 19 сентября 2007г. 19:21:31

Re: Связь графических объектов и текста

Сообщения с 26 по 50 из 80

Тему читают: 1 гость

Вход на форум «Форумы CADUser»x

Ссылки