[Ax3]

Здравствуйте, коллеги!
Подскажите, плз, такую вещь.
Надо вписать mtext в заданный прямоугольник. Как программно определить, что текст, введенный пользователем, выходит за границы этого прямоугольника?
Это нужно для того, чтобы в зависимости от количества слов выбирать высоту текста так, чтобы он поместился в прямоугольник. Причем высоту текста надо выбирать из стандартного ряда, то есть fit не подходит.

Всем успехов!

[VVA]

>Ax3 Чтобы легче жевалось

Код:

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

;;;================================================================================ 
;;; Функция добавляет Расширенные Данные (РД) к примитиву 
;;; ENAME - Имя примитива 
;;; RNAME - имя приложения 
;;; (-3 ("MIP_XD" (1000.METKA))) 

(DEFUN _add_txt_dictxd1 
       (ENAME RNAME  / XDLIST ELIST METKA XD_ENT XD_LIST3) 
  (regapp RNAME) 
  (setq ELIST (entget ENAME '("*"))) 
  (setq METKA (cdr (assoc 5 ELIST))) 
  (setq XDLIST (list (cons 1000 METKA))) 
  (setq XDLIST (list (cons RNAME XDLIST))) 
  (setq XDLIST (cons -3 XDLIST)) 
  (if (< (xdsize XDLIST) (xdroom ENAME)); Если есть еще пространство... 
    (progn 
      (if (assoc -3 ELIST)      ; и уже есть Рданные... 
   (progn 
     (setq XDLIST (cdr XDLIST))   ; Новые Рданные. 
     (setq XD_ENT (cdr (assoc -3 ELIST))) ; Старые Рданные. 
     ;; Найти старые Рданные для того же приложени 
     (if (assoc RNAME XD_ENT) 
       (progn 
         (setq XD_LIST3 (subst (car XDLIST) 
                (assoc RNAME XD_ENT) 
                (assoc -3 ELIST) 
              ) ;_ End of subst 
         ) ;_ End of setq 
       ) ;_ End of progn 
       (progn         ; Это новое приложение... 
         (setq XDLIST (append XD_ENT XDLIST)); Объединить Рданные. 
         (setq XD_LIST3 (cons -3 XDLIST)) 
       ) ;_ End of progn 
     ) ;_if assoc RNAME 
     (setq ELIST (subst XD_LIST3 (assoc -3 ELIST) ELIST)); Объединить с примитивом 
   ) ;_progn 
   (setq ELIST (cons XDLIST ELIST)) ; Пока нет Рданных. 
      ) ;_if assoc -3 
    ) ;_progn 
    (princ (strcat "\nНе хватает памяти для Рданных" 
         "- Рданные не добавлены." 
      ) ;_ End of strcat 
    ) ;_ End of princ 
  ) ;_if < xdsize
  (entmod ELIST)) 
;;;================================================================================ 
;;; Функция возвращает Расширенные Данные(РД)  примитива 
;;; в виде списка (METKA KOD STR) или NIL, если РД не присвоено 
(DEFUN _get_txt_dictxd (ENAME RNAME / XDLIST ELIST XD_ENT sps) 
  (setq ELIST (entget ENAME (list RNAME))) 
  (setq XD_ENT (cdr (assoc -3 ELIST)))   ; Старые Рданные. 
  ;; Найти старые Рданные для того же приложени 
  (if (setq XDLIST (assoc RNAME XD_ENT)) 
    (progn 
      (setq XDLIST (cdr XDLIST)) 
      (foreach aa XDLIST 
   (setq sps (append sps (list (cdr aa)))) 
      )    
    ) ;_ End of progn 
  ) ;_if 
  sps 
) ;_END defun _get_mark_xd 

;;Создаем связь мтекста полилинии и круга
(defun C:TEST ( )
  (vl-load-com)
  (and 
    (princ "\nУкажите мтекст") 
    (setq mtext (ssget "_:S:E:L" '((0 . "MTEXT")))) 
    (setq mtext (ssname mtext 0)) 
    (princ "\nУкажите ссылочную полилинию") 
    (setq rect (ssget "_:S:E:L" '((0 . "*POLYLINE"))))
    (setq rect (ssname rect 0))
    (princ "\nУкажите ссылочный круг") 
    (setq circ (ssget "_:S:E:L" '((0 . "CIRCLE"))))
    (setq circ (ssname circ 0))
    (_add_txt_dictxd1 mtext "MTEXT+RECTANGLE" ) ;_Добавляем в РД к mtexty
    (_add_txt_dictxd1 rect  "MTEXT+RECTANGLE" ) ;_Добавляем РД к прямоугольнику
    (_add_txt_dictxd1 circ  "MTEXT+RECTANGLE" ) ;_Добавляем РД к кругу
    ;;;Формируем X-RECORD (словарь)
    ;;;Сам словарь, организованный ввиде ассоциативного списка
    ;;; '(("KEY1" Handle1)("KEYN" HandleN))
    ;;; Ключевые поля "KEY" могут принимать значения
    ;;; "PLN" - ссылка на полилинию
    ;;; "CIRC" - ссылка на круг
    ;;; "MTEXT" - ссылка на мтекст
    (setq dict (list
        (list "PLN" (cdr(assoc 5 (entget rect))))
        (list "MTEXT" (cdr(assoc 5 (entget mtext))))
        (list "CIRC" (cdr(assoc 5 (entget circ))))
        )
          )
    (vlax-ldata-put
      (vlax-ename->vla-object mtext) ;_Объект словаря Мтекст
      "MTEXT+RECTANGLE" ;_Ключ словаря
      dict
      )
    (vlax-ldata-put
      (vlax-ename->vla-object rect) ;_Объект словаря полилиния
      "MTEXT+RECTANGLE" ;_Ключ словаря
      dict
      )
    (vlax-ldata-put
      (vlax-ename->vla-object circ) ;_Объект словаря круг
      "MTEXT+RECTANGLE" ;_Ключ словаря
      dict
      )
      )
 ) 
  
;;Визуализируем все связанные MTEXT и прямоугольники 
(defun C:TEST1 () 
  (if (setq ss (ssget "_X" '((0 . "MTEXT,*POLYLINE,CIRCLE")(-3 ("MTEXT+RECTANGLE"))))) ;_Выбираем все MTEXT+POLYLINE c РД MTEXT+RECTANGLE 
    (sssetfirst ss ss)) 
  ) 
;;Находим пару созданной связи MTEXT+RECTANGLE 
(defun C:TEST2 ( )
  (vl-load-com)
  (and 
    (princ "\nУкажите связанный мтекст , полилинию или круг") 
    (setq en (ssget "_:S:E:L" '((0 . "MTEXT,*POLYLINE,CIRCLE")))) 
    (setq en (ssname en 0)) 
    (setq lst (_get_txt_dictxd en "MTEXT+RECTANGLE")) 
    (= (cdr(assoc 5 (entget en))) (car lst))  ;_Не изменилась ли запомненная метка самого примитива (те не копия ли это)
    ;;;Берем из X-REC словарь ввиде ассоциативного списка
    (setq dict (vlax-ldata-get (vlax-ename->vla-object en) "MTEXT+RECTANGLE"))
    (setq ss (ssadd)) ;;Пустой набор
    (foreach en2 dict
      (setq en2 (cadr en2)) ;_Метка пары
      (setq en2 (handent en2)) ;_Имя примитива пары
      (entget en2) ;_Не удален ли, если удален entget вернет nil
      (ssadd en2 ss)
      )
    (sssetfirst ss ss) 
    (setq ss nil) 
    ) 
  ) 

;;Находим Круг созданной связи MTEXT+RECTANGLE 
(defun C:TEST3 ( )
  (vl-load-com)
  (and 
    (princ "\nУкажите связанный мтекст , полилинию") 
    (setq en (ssget "_:S:E:L" '((0 . "MTEXT,*POLYLINE")))) 
    (setq en (ssname en 0)) 
    (setq lst (_get_txt_dictxd en "MTEXT+RECTANGLE")) 
    (= (cdr(assoc 5 (entget en))) (car lst))  ;_Не изменилась ли запомненная метка самого примитива (те не копия ли это)
    ;;;Берем из X-REC словарь ввиде ассоциативного списка
    (setq dict (vlax-ldata-get (vlax-ename->vla-object en) "MTEXT+RECTANGLE"))
    (setq ss (ssadd)) ;;Пустой набор
    (setq en2 (cadr(assoc "CIRC" dict))) ;_Берем метку круга
    (setq en2 (handent en2)) ;_Имя примитива пары
    (entget en2) ;_Не удален ли, если удален entget вернет nil
    (ssadd en2 ss)
    (sssetfirst ss ss) 
    (setq ss nil) 
    ) 
  )

В примере учавствуют мтекст, полилиния и круг.

[Ax3]

Впечатлен, VVA, спасибо.