[Ax3]

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

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

[Ax3]

Может, подскажет кто хотя бы где копать?
dxf, activex? или, может, я плохо хелп смотрел. Что-то никак ничего похожего не найду.
Или самому считать, умножая кол-во символов в тексте на их среднюю ширину?

[Кулик Алексей aka kpblc]

Используй textbox - имхо самое то.

[Ax3]

в смысле

Код:

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

(texbox <что-нибудь>)

?

[Yura]

Да, у меня эта команда тоже че-то не прошла... :cry:
И в хэлпе че-то не видать...

[Кулик Алексей aka kpblc]

В смысле наподобие:

Код:

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

(defun test (str)
  (textbox (list '(0 . "MTEXT")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbMText")
                 '(10 0. 0. 0.0)
                 '(40 . 2.5)
                 '(41 . 0.0)
                 '(71 . 1)
                 '(72 . 1)
                 (cons 1 str)
                 '(7 . "Standard")
                 '(210 0.0 0.0 1.0)
                 '(11 1.0 0.0 0.0)
                 '(50 . 0.0)
                 '(73 . 1)
                 ) ;_ end of list
           ) ;_ end of textbox
  ) ;_ end of defun

[Alaspher]

Сообщение от Ax3 в смысле Код: [Выделить все] (texbox <что-нибудь>) ?

Пример:

Код:

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

(textbox '((40 . 1200.0) (1 . "ergereagaeg") (41 . 0.85) (7 . "RomanS")))

Но это годится только для однострочных. С многосторчным, честно говоря - не знаю, как быть. Есть вариант подбора создавать примитив, потом проверять его размер (vla-GetBoundingBox ...), если не входит - уменьшать размер и проверять снова... Но не знаю, как это будет работать - не пробовал.

[Кулик Алексей aka kpblc]

> Alaspher : для многострочного надо просто полный список задавать, достаточный для entmakex - как правило, срабатывает

[Alaspher]

> Алексей
Голову на это не поставлю, но моя думай - нифига не выйдет. Попробуй получить реальные точки имеющегося многострочного текста.

[AY]

С mtext у меня через textbox что-то не получается как Алексей предлагает. А с boundingbox тоже засада. Если width у mtext не равна нулю то boundingbox возвращает прямоугольник с шириной равной width даже если слово, которое не перенеслось, выходит за эти габариты. А если width приравнять нулю то текст может разъехаться, когда переносы строк установлены не жестко, и результат все равно будет не корректный (разве что обязать пользователя расставлять переносы строк).

Как идея: может взрывать mtext и анализировать набор однострочных текстов?

Кстати, что касается textbox недавно столкнулся с одной особенностью - если в начале текста есть пробелы или что-то вроде "%%u ля-ля-ля " (у меня был именно такой вариант) то функция игорирует такие вещи и не понятно как привязать ее результат "на местности". boundingbox - в отличии от textbox работает более корректно и результат дает сразу "с привязкой к месту", но имеет дело только с реальными объектами - вот и выбирай, как говорится.

[Кулик Алексей aka kpblc]

Alaspher, как всегда, прав. Код

Код:

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

(textbox (vl-remove-if '(LAMBDA(x) (member(car x) '(-1 5 330)))(entget (entlast))))

вываливает 0xC0000005 (Нарушение доступа). Ессно, (entlast) - многострочник. Исключение необязательных групп тоже ничего не дает.
P.S. Проверял на ADT 2k5 Eng +SP1, ADT 2k6 Rus + SP1. Запуск ADT как ACADa проблему не решает. Кошмар...

[VVA]

Варианты в порядке бреда:
1. копировать mtext в укромное место, там взрывать и брать textbox'ы того, что осталось. Правда потеряется, если есть, форматирование.
2. создать блок (можно анонимный), скопировать в него mtext и попробывать определить boundingbox блока.
Все на основе догадок, без проверок и гарантий

[AY]

>VVA
С блоком результат такой же как напрямую с mtext, т.е. со всеми камнями о которых я писал выше.

[VVA]

У меня получилось так

Код:

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

(setq lst (ACET-GEOM-OBJECT-POINT-LIST (car(entsel)) 1e-3))
(setq cc (getvar "CECOLOR"))
(setvar "CECOLOR" "1")
(command "_pline")
(foreach pt lst
  (command "_none" pt))
(command "")(command)
(setvar "CECOLOR" cc)

Нужен установленный Express Tools

[AY]

>VVA
Действительно mtext обрабатывется корректно в отличии от boundingbox (хотя рамка получается чуть больше, но это, пожалуй, несущесвенно). А вот простой текст содержащий такую строку "%%u asdfsdf " обрабабатывается не корректно в отличии от того же boundingbox. Как написал Крыс - Кошмар...

ps Выходит сами писатели автокадовские используют ACET-GEOM-OBJECT-POINT-LIST, а простым смертным глючный boundingbox подсовывают. Молодцы, молодцы...

[VVA]

Тоже сталкивался с тем, что acet-* ф-ции работают иногда более корректно. Правда почитать что-нубудь негде.
Нашел описания здесь http://www.theswamp.org/index.php?topic=13719.0 но там только названия. Там есть еще ACET-GEOM-TXTBOX. правда не знаю что ей скармливать в качестве аргументов.

[VVA]

А вот еще одна ACET-GEOM-TEXTBOX

Код:

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

(setq lst (ACET-GEOM-TEXTBOX (entget (car(entsel))) 1e-3)) 
(setq cc (getvar "CECOLOR")) 
(setvar "CECOLOR" "1") 
(command "_pline") 
(foreach pt lst 
  (command "_none" pt)) 
(command "_close")(command) 
(setvar "CECOLOR" cc)

[AY]

ACET-GEOM-TXTBOX - даже лучше работает с mtext, однако с однострочным текстом проблемы остаются. Впрочем как, показали тесты проблемы с перфиксными пробелами имеются только у ttf-шрифтов; shx - обрабатываются корректно.

Короче, вывод - наиболее корректны следующие связки:
Mtext - (ACET-GEOM-TXTBOX ...) [ExpressTools]
Text - (vla-GetBoundingBox ...)

[Ax3]

:shock:
Парни, я с трудом поспеваю за ходом ваших мыслей!
У меня такая проблема.
В чертеже есть несколько mtext'ов. Пользователь редактирует mtext.
Не работают вот эти варианты:

Код:

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

(defun app_func (calling-reactor commandInfo / einf_ ename_ etype_ tbox_)
  (setq ename_ (cadr commandInfo))
  ;(print)
  ;(print ename_)
  (setq einf_ (entget ename_))
  ;(print einf_)
  (setq etype_ (assoc 0 einf_))
  (setq etype_ (cdr etype_))
  ;(print etype_)
  (if (= etype_ "MTEXT") (setq tbox_ (textbox (list (cons -1 ename_)))))
  (print tbox_)
)
(vlr-acdb-reactor nil '((:vlr-objectModified  . app_func)))

возвращает nil. Не пойму, в чем подвох. При попытке указания полного списка

Код:

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

(defun app_func (calling-reactor commandInfo / einf_ ename_ etype_ tbox_)
  (setq ename_ (cadr commandInfo))
  ;(print)
  ;(print ename_)
  (setq einf_ (entget ename_))
  ;(print einf_)
  (setq etype_ (assoc 0 einf_))
  (setq etype_ (cdr etype_))
  ;(print etype_)
  (if (= etype_ "MTEXT") (setq tbox_ (textbox einf_)))
  (print tbox_)
)
(vlr-acdb-reactor nil '((:vlr-objectModified  . app_func)))

тоже nil. Ерунда какая-то

Зато вариант

Код:

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

(defun app_func (calling-reactor commandInfo / einf_ ename_ etype_ tbox_)
  (setq ename_ (cadr commandInfo))
  ;(print)
  ;(print ename_)
  (setq einf_ (entget ename_))
  ;(print einf_)
  (setq etype_ (assoc 0 einf_))
  (setq etype_ (cdr etype_))
  ;(print etype_)
  (if (= etype_ "MTEXT") (setq tbox_ (textbox (list (cons 1 "test_text")))))
  (print tbox_)
)
(vlr-acdb-reactor nil '((:vlr-objectModified  . app_func)))

работает. Но очевидная проблема - если два одинаковых текста в чертеже, то... Ну короче понятно.

В чем проблеме, никак не догоню.

[Ax3]

Еще раз перечитал. Не в том ли проблема, что textbox анализирует текст виртуальный, в смысле строку, передаваемую ей в качестве аргумента, и никак не связана с текстом на чертеже?

[Ax3]

ACET-GEOM-TXTBOX - это уже кажись то шо ну. Спасибо огромное!!!

Кстати, я в Питере буду в середине августа. Хочу отблагодарить господ учаснтиков форума например пивом. Как бы это сделать?

[Ax3]

ACET-GEOM-TEXTBOX - из express tools?
Где-нибудь ее исходник есть?

вот в таком виде у меня заработало:

Код:

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

(defun app_func (calling-reactor commandInfo / einf_ ename_ etype_ lst_ pt_)
  (setq ename_ (cadr commandInfo))
  (setq einf_ (entget ename_))
  (setq etype_ (assoc 0 einf_))
  (setq etype_ (cdr etype_))
  (if (= etype_ "MTEXT")
    (progn
    (setq lst_ (ACET-GEOM-TEXTBOX einf_ 1e-4));спасибо VVA@forum_dwg.ru_2007.07.25
    (print lst_)
    ;+ сделать еще много чего :-)
    )
  )
)
(vlr-acdb-reactor nil '((:vlr-objectModified  . app_func)))

Еще раз спасибо всем.

[VVA]

> Ax3
1. Да
2. Нет
3. Узнать хотя бы названия ф-ций можно по ссылке из поста № 16
Далее я делаю так:
В папке express tools в файлах *.lsp ищу с помошью total comander'a (Atl+F7) файлs, в которых встречается упоминание заинтересовавшей меня ф-ции. Анализируя код, узнаю количество и порядок передаваемых ей аргументов. Если нет, то пробую поискать в google.

[VVA]

Кстати, я в Питере буду в середине августа. Хочу отблагодарить господ учаснтиков форума например пивом. Как бы это сделать?

Ехать в Питер через Минск

[Кулик Алексей aka kpblc]

Я не помню, кто меня ткнул носом (каюсь, виноват) в ссылку http://afralisp.net/lisp/acet-utils.htm

[Ax3]

Хорошая страничка, дельная.
То есть с точки зрения программиста эти функции можно рассматривать как встроенные в лисп и соответственно без проблем ими пользоваться (при наличии ET, конечно)?
>VVA
В Минске буду в командировке когда-нибудь. Надеюсь.

[Ax3]

Кстати, еще вопрос, не хочу в отдельную тему выносить:
Можно ли средствами автокада в описание примитива или блока или вообще объекта засунуть указание на другой объект, с которым он связан? То есть чтобы пользователю это не было видно, а лиспик знал, с каким именно прямоугольником связан данный текст.
Смысл в том, что блок делать неохота, потому что в нем mtext не меняется, а многострочных атрибутов я чего-то не встретил на своем пути.

[Кулик Алексей aka kpblc]

с точки зрения программиста эти функции можно рассматривать как встроенные в лисп и соответственно без проблем ими пользоваться (при наличии ET, конечно)?

Теоретически да. Некоторые из этих функций постепенно кочуют в ядро AutoCAD'a

Можно ли средствами автокада в описание примитива или блока или вообще объекта засунуть указание на другой объект, с которым он связан? То есть чтобы пользователю это не было видно, а лиспик знал, с каким именно прямоугольником связан данный текст. Смысл в том, что блок делать неохота, потому что в нем mtext не меняется, а многострочных атрибутов я чего-то не встретил на своем пути.

В 2008, как я слышал, многострочные атрибуты уже существуют. Если на 2008 не завязываться, то можно использовать либо расширенные данные, либо ldata (лично я предпочитаю второй путь). Хранить надо хендл второго примитива. Хендл хранится в 5 группе. Его также можно получить как (vla-get-handle ent). Коды для записи и чтения ldata:

Код:

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

(defun _kpblc-ent-ldata-get (ent)
                            ;|
*    Функция возвращает дополнительные данные, записанные в примитив (либо nil,
* если их нет)
*    Параметры вызова:
*	ent	указатель на примитив
*    Примеры вызова:
(_kpblc-ent-ldata-get (vlax-ename->vla-object (car (entsel))))
|;
  (if (or (eq ent *kpblc-model*)
          (and (= (type ent) 'str)
               (= (strcase ent) (strcase *kpblc-regname*))
               ) ;_ end of and
          ) ;_ end of or
    (setq ent *kpblc-regname*)
    (setq ent (_kpblc-conv-ent-to-vla ent))
    ) ;_ end of if
  (if (vlax-ldata-get ent *kpblc-appname*)
    (_kpblc-conv-list-to-lowcase
      (_kpblc-conv-list-to-pointlist
        (vlax-ldata-get ent *kpblc-appname*)
        ) ;_ end of _kpblc-conv-list-to-pointlist
      ) ;_ end of _kpblc-conv-list-to-lowcase
    ) ;_ end of if
  ) ;_ end of defun

(defun _kpblc-ent-ldata-add (ent data-list append-data / exist_data res)
			    ;|
*    Функция внесения дополнительных данных в примитив либо словарь.
*    Параметры вызова:
*	ent		примитив, в который вносятся данные. Если примитив -
*			пространство модели, то создается глобальный словарь
*			с именем *kpblc-regname* и данные вносятся в него
*	data-list	вносимые данные
*	append-data	t - заменять полностью
*			nil -> только указанные пары (заменить либо добавить)
*    Возвращаемое значение:
*	полный список доп.данных или nil, если невозможно записать.
*    Примеры вызова:
(_kpblc-ent-ldata-add (vlax-ename->vla-object (car (entsel))) '(("block" . "data1")) t)
|;
  (if (or (eq ent *kpblc-model*)
	  (and (= (type ent) 'str)
	       (= (strcase ent) (strcase *kpblc-regname*))
	       ) ;_ end of and
	  ) ;_ end of or
    (setq ent *kpblc-regname*)
    (setq ent (_kpblc-conv-ent-to-vla ent))
    ) ;_ end of if

  (if (and (not append-data)
	   (setq exist_data (_kpblc-ent-ldata-get ent))
	   ) ;_ end of and
    (setq data-list (append data-list exist_data))
    ) ;_ end of if
  (vl-catch-all-apply '(lambda () (vlax-ldata-delete ent *kpblc-appname*)))
  (foreach item	(_kpblc-list-dublicates-remove data-list)
    (if	(not (member (car item) (mapcar 'car res)))
      (setq res (append res (list item)))
      ) ;_ end of if
    ) ;_ end of foreach
  (vlax-ldata-put ent *kpblc-appname* res)
  ) ;_ end of defun

Тут используется несколько библиотечных функций и глобальных переменных, но, думаю, сам принцип понятен.

[Ax3]

Да, понятен. Благодарю. Что б я без вас делал, уважаемые!

[VVA]

>Кулик Алексей aka kpblc ссылка хорошая, у меня давно живет в избранных, но неполная :cry:
> Ax3 Я использую связку Расширенных Данных (РД)+ ldata
Расширенные данные можно выбирать через ssget
Для твоего случая выриант с РД
Метка примитива = хэндл

Код:

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

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

(DEFUN _add_txt_dictxd
       (ENAME RNAME DICT / XDLIST ELIST METKA XD_ENT XD_LIST3)
  (regapp RNAME)
  (setq ELIST (entget ENAME '("*")))
  (setq METKA (cdr (assoc 5 ELIST)))
  (setq XDLIST (list (cons 1000 DICT)(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 ( )
  (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))
    (_add_txt_dictxd mtext "MTEXT+RECTANGLE" (cdr(assoc 5 (entget rect)))) ;_Добавляем в MTEXT ссылку на прямоугольник
    (_add_txt_dictxd rect  "MTEXT+RECTANGLE" (cdr(assoc 5 (entget mtext)))) ;_Добавляем в прямоугольник ссылку на MTEXT
    )
  )
;;Визуализируем все связанные MTEXT и прямоугольники
(defun C:TEST1 ()
  (if (setq ss (ssget "_X" '((0 . "MTEXT,*POLYLINE")(-3 ("MTEXT+RECTANGLE"))))) ;_Выбираем все MTEXT+POLYLINE c РД MTEXT+RECTANGLE
    (sssetfirst ss ss))
  )
;;Находим пару созданной связи MTEXT+RECTANGLE
(defun C:TEST2 ( )
  (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))) (cadr lst))  ;_Не изменилась ли запомненная метка самого примитива (те не копия ли это)
    (setq en2 (car lst)) ;_Метка пары
    (setq en2 (handent en2)) ;_Имя примитива пары
    (entget en2) ;_Не удален ли, если удален entget вернет nil
    (setq ss (ssadd en))
    (ssadd en2 ss)
    (sssetfirst ss ss)
    (setq ss nil)
    )
  )

[Ax3]

Угу...
Как раз бутерброд с колбасой нескучно будет есть...

[ShaggyDoc]

Сообщение от VVA Тоже сталкивался с тем, что acet-* ф-ции работают иногда более корректно. Правда почитать что-нубудь негде. Нашел описания здесь http://www.theswamp.org/index.php?topic=13719.0 но там только названия. Там есть еще ACET-GEOM-TXTBOX. правда не знаю что ей скармливать в качестве аргументов.

http://www.jtbworld.com/download/acetutil.zip

Справка по функциям. Правда, устаревшая, но помогает.

[Ax3]

И еще раз - огромное спасибо всем, всем, всем!!!
Тема еще не закрыта, пишу прогу, надеюсь, скоро выложу.
>kpblc, VVA
Парни, вы гении.

[Ax3]

Не совсем понял разницы между xdata и idata. Можно вкратце пояснить?

[VVA]

Xdata - extended object data или расширенные данные (РД), хранятся в описании примитива в группе -3 в соответствии со своим кодом подгруппы (строка -1000, целое - 1070 и т.д.) Где почитать подробнее и минусы см. у Алексея http://www.arcada.com.ua/forum/viewt...418f41ab9e777c

Код:

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

(entget (car (entsel)) '("*"))

((-1 . <Имя объекта: 7ef70e08>) (0 . "MTEXT") (330 . <Имя объекта: 7ef70d08>) (5 . "41") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbMText") (10 124.49 92.716 0.0) (40 . 30.1982) (41 . 117.705) (71 . 1) (72 . 5) (1 . "erfgergfergfeer") (7 . "МИП_ГОСТ") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 295.616) (43 . 40.6945) (50 . 0.0) (73 . 1) (44 . 1.0) (-3 ("MTEXT+RECTANGLE" (1000 . "3E") (1000 . "41"))))

Но у них есть один плюс: Имя РД можно использовать как фильтр ssget
(в моем примере в команде TEST1)

(setq ss (ssget "_X" '((0 . "MTEXT,*POLYLINE")(-3 ("MTEXT+RECTANGLE")))))

Это позволяет быстро отфильтровать нужные тебе примивы. Я уже говорил и еще раз повторю, что, на мой взгляд, самое рациональное использовать связку РД и vlax-ldata-*.
В РД используются только строковые поля (1000), чтобы не "захломлять", так как 16 кб делятся на всех. Но у нас появляется возможность фильтровать примитивы с помощью ssget.
В моем примере записываются 2 строковых поля:
первое - метка (хэндл) примитива, на который ссылаемся
второе - метка (хэндл) самого примитива. Это нужно для того, чтобы отсечь скопированный (если нужно) примитив. Т.к. в этом случае запомненная метка примитива и метка самого примитива не будут совпадать.
Остальные данные можно хранить в X-records (X-записях) самого примитива. Тут тоже есть варианты.
1. Использовать встроенные ф-ции vlax-ldata-*
2. Посмотреть ф-ции Пётра В. Лоскутова Набор функций для хранения данных в словарях, версия: 0.95

Вообще настоятельно рекомендую две вещи:
1. Найти книгу, о которой говорит Алексей. (Приобрести уже навряд ли)
2. Тщательно проработать файл из Express Tools xdata.lsp (Пример работы с РД, команда XDATA)

Уф, думаю для первого раза достаточно

[Кулик Алексей aka kpblc]

> VVA : Как ни парадоксально, книга еще продается

[VVA]

>Кулик Алексей aka kpblc Я думаю, что эта книга вполне бы выдержала переиздание (совет издателям)

[Ax3]

Я понял, спасибо. Тему эту изучу, а пока остановлюсь все-таки на xdata, потому что уже научился с ними работать :-). И в условиях моей задачи в каждом объекте будут храниться ссылки максимум на 4-5 других объектов, так что 16к должно хватить.

[Alaspher]

Сообщение от Кулик Алексей aka kpblc > VVA : Как ни парадоксально, книга еще продается

Озон, по обыкновению жжёт:

С этим товаром часто покупают: Учимся танцевать. Танец живота. Арабские танцы Дж. К. Ролинг Гарри Поттер и Орден Феникса Сергей Лукьяненко Ночной Дозор. Дневной Дозор. Сумеречный Дозор

Представил покупателя - плакал

Сообщение от VVA >Кулик Алексей aka kpblc Я думаю, что эта книга вполне бы выдержала переиздание (совет издателям)

Так собственно, переиздание уже состоялось, но с новым названием - AutoLISP и Visual LISP в среде AutoCAD

Сообщение от Ax3 в условиях моей задачи в каждом объекте будут храниться ссылки максимум на 4-5 других объектов, так что 16к должно хватить.

Аппетит приходит во время еды - лучше сразу привыкать хранить данные отдельно от примитивов, это более чистое решение и более масштабируемое.

[Ax3]

Озон, по обыкновению жжёт: Цитата: С этим товаром часто покупают: Учимся танцевать. Танец живота. Арабские танцы Дж. К. Ролинг Гарри Поттер и Орден Феникса Сергей Лукьяненко Ночной Дозор. Дневной Дозор. Сумеречный Дозор

Очень забавно!
Alaspher, я учту твою рекомендацию. Просто хотелось схалтурить немножко , хотя и сам понимаю, что лучше сразу нормально делать. А то сразу выставленное ограничение в 4-5 блоков запросто может оказаться маловато. Ладно, буду изучать, запасаюсь бутербродами...

[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, спасибо.