[PlayKid]

Здравствуйте уважаемые.
По роду деятельности очень часто приходиться иметь дело с конвертированными с различных систем проектирования чертежах, а также разного рода "разноруких" любителей "рисовать" чертежи.
Особенно замучился с рисованными (иначе не назовешь) таблицами.
Проблема заключалась в том, что необходимо было текст (в основном MText) в этих самых таблицах растягивать на всю величину ячейки, для того, что бы придать им хоть какой-то эстетический вид (кто встречался с той же проблемой, я думаю меня понимает).
Ну так вот, что бы как то автоматизировать это, мной был написан вот такой лисп(рабочий):

Код:

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

(defun C:MHatch    ( / SS1 SS2 i dju1 qw koor maxx minx maxy miny Rad Ln Sh сx сy stl x y)
  (setvar "CMDECHO" 0)
;; загружаем функции для работы с объектами  
  (vl-load-com)
;; сохраняем значение системной переменной HPGAPTOL в переменной dju1
  (setq dju1 (getvar "HPGAPTOL"))
;; выделяем МТекст и помещаем его в набор ss1  
  (setq ss1 (ssget '((0 . "MText"))))
;; извлекаем из элемента список и сохраняем его в qw
  (setq qw (entget (ssname ss1 0)))
;; удаляем "старый" MText
  (command "_erase" ss1 "")
;; находим в списке пару содержащую координаты (код 10) и сохраняем в koor
  (setq koor (cdr (assoc 10 qw)))
;; устанавливаем значение системной переменной HPGAPTOL в удовлетворяющее нас больше (1)
  (setvar "HPGAPTOL" 1)
;; делаем заливку области с координатами koor средствами AutoCad
  (command "_.bhatch" "_p" "SOLID,_I" koor "")
;; выбираем заливку и помещаем ее в набор ss2  
  (setq ss2 (ssget "_L"))
;; возвращаем значение системной переменной HPGAPTOL на то что было до изменения(запомнили в переменной dju1)
  (setvar "HPGAPTOL" dju1)
;; извлекаем список из заливки и находим координаты крайних точек заливки
  (setq ss2obj (vlax-ename->vla-object (cdr (assoc -1 (entget(ssname ss2 0))))))
  (vla-GetBoundingBox ss2obj 'minp 'maxp)
  (setq minx (nth 0 (vlax-safearray->list minp)))
  (setq miny (nth 1 (vlax-safearray->list minp)))
  (setq maxx (nth 0 (vlax-safearray->list maxp)))
  (setq maxy (nth 1 (vlax-safearray->list maxp)))
;; Удаляем заливку
  (setq ss2 (vlax-vla-object->ename ss2obj))
  (command "_erase" ss2 "")
;; Вычисляем координаты нового положения МТекст и габаритные размеры контейнера
  ;; Длина и ширина (учитывая ординатный поворот текста)
  (setq Rad (cdr (assoc 50 qw)))
  (cond
    ((= Rad 0) (setq Ln (- maxx minx) Sh (- maxy miny)))
    ((= Rad (/ pi 2)) (setq Sh (- maxx minx) Ln (- maxy miny)))
    ((= Rad pi) (setq Ln (- maxx minx) Sh (- maxy miny)))
    ((= Rad (+ pi (/ pi 2))) (setq Sh (- maxx minx) Ln (- maxy miny)))
  )
  ;; Координаты центра
  (setq cx (- maxx (/ (- maxx minx) 2)) cy (- maxy (/ (- maxy miny) 2)))    
;; модифицируем список
;; Определяем текущее значение точки втавки(выравнивание) 
  (setq stl (cdr (assoc 71 qw)))
  (cond
    ((= stl 1) (setq x minx y maxy))
    ((= stl 2) (setq x cx y maxy))
    ((= stl 3) (setq x maxx y maxy))
    ((= stl 4) (setq x minx y cy))
    ((= stl 5) (setq x cx y cy))
    ((= stl 6) (setq x maxx y cy))
    ((= stl 7) (setq x minx y miny))
    ((= stl 8) (setq x cx y miny))
    ((= stl 9) (setq x maxx y miny))
  )  
;; Обрабатываем новые габариты контейнера и точку вставки 
  (setq qw (subst (cons 41 Ln) (assoc 41 qw) qw))
  (setq qw (subst (cons 46 Sh) (assoc 46 qw) qw))
  (setq qw (subst (cons 10 (list x y 0.0)) (assoc 10 qw) qw))
;; Создаем новый объект Mtext  
  (entmake qw)
;; завершение  
  (princ)
)

Но, так как я только постигаю азы этого прекрасного инструмента (AutoLisp), возникло у меня ряд вопросов к ЗНАЮЩИМ.
В часности:
1)
;; Удаляем заливку
(setq ss2 (vlax-vla-object->ename ss2obj))
(command "_erase" ss2 "")
как можно удалить объект не производя обратного преобразования.
2)
;; делаем заливку области с координатами koor средствами AutoCad
(command "_.bhatch" "_p" "SOLID,_I" koor "")
можно ли не используя команд AutoCad выполнить тоже самое в Lisp,
без написания алгоритма поиска границ.
3) можно ли вообще в данном лиспе не использовать команды AutoCad.

Хотелось бы увидеть ответы с небольшими пояснениями, или на крайний случай с ссылками.

Ну и в общем, с удовольствие почитал бы, что можно было бы сделать по другому или дополнить чем.

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

Есть пара вариантов другого характера.
1. Попытаться сделать нормальную таблицу (AutoCAD'овскую имею в виду).
2. Предварительно выбрать тексты и отрезки (полилинии), отсортировать их по координатам и после этого уже анализировать расположение ближайших вертикальных отрезков.
Оба варианта породят проблемы для "таблиц" с объединенными по горизонтали ячейками. Хотя, в download не далее как вчера был выложен архив программ Alaspher'a с сайта uniip.ru - там был код, позволяющий выполнять экспорт подобных "таблиц" в файлы Excel'a.

[PlayKid]

Спасибо за ответ, мне он очень нравится, но не совсем подходит, на это есть несколько причин, одна из которых в том, что не только таблицы определяют область применения данного лиспа, очень часто необходимо обрабатывать всевозможные чертежи с множеством диаграм, структурных схем и др.
И данные там(текст) находятся не в таблице, но в рамке, да и много всякого другого где необходимо пользоваться именно этим лиспом.
Да и кроме того для простых таблиц я сделал лисп для простого экспорта(в три действия) текста из "псевдотаблиц" в Автокадовскую нормальную предварительно созданную таблицу(хотя программно создать новую по ходу экпорта тоже конечно не проблема), но это, как говорится, другая история.
Что касается моих вопросов, то мне просто интересно, так сказать для общего развития. Угробил несколько дней на поиск ответа, но так ничего и не нашел. Пришел к выводу что реально сделать заливку в лиспе, указав только точку лежащую внутри замкнутого контура, практически не возможно. Насколько я понял заливка средствами AutoLISP выполняется, если указать примитивы допустимого типа, образующие замкнутый контур, а вот если указывать только координаты точки, то нужно самому определить эти самые примитивы, что в принципе довольно легко решаемо при не сложной конфигурации такой области, но вот если это сложная область, возникает довольно не тривиальная задача, реализовать которую, в принципе, возможно, но это будет гораздо больше по коду(да наверно и по времени выполнения) чем заливка средствами Автокад, в которой, как я понимаю, все это уже реализовано.
Если я не прав (кстати надеюсь на это), то ОЧЕНЬ хотел бы увидеть описание способа реализации всего этого в LISP-е.

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

Лично я в первую очередь все же разделил бы задачи. То есть таблицы обрабатывать одним лиспом, диаграммы - другим и т.д. Ну да ладно, это я опять "вперед паровоза" рванул
Ну вот, например, вариант установки ширины многострочникам по 2 ближайшим вертикальным отрезкам. Учитывает варианты вертикальных кусков полилиний.

Код:

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

(defun set-mtext-width (off / adoc *error* ent pt selset _kpblc-conv-selset-to-ename align ent_l ent_r ins w lines)
                       ;|
*    off -> расстояние от текста до вертикального ограничителя, в ед.чертежа.
		nil -> 0.25
*    Примеры вызова:
(set-mtext-width nil)
(set-mtext-width 0.6)
|;

  (defun _kpblc-conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
	selset	набор примитивов
*    Примеры вызова:
(_kpblc-conv-selset-to-ename (ssget))
|;
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type (setq selset (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (ssget '((0 . "MTEXT,LINE,LWPOLYLINE")))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
          ;) ;_ end of and
    (progn
      (if (not off)
        (setq off 0.25)
        ) ;_ end of if
      (setq selset (_kpblc-conv-selset-to-ename selset)
            mtext  (vl-remove-if-not
                     (function
                       (lambda (x)
                         (= (cdr (assoc 0 (entget x))) "MTEXT")
                         ) ;_ end of lambda
                       ) ;_ end of function
                     selset
                     ) ;_ end of vl-remove-if-not
            selset (vl-remove-if
                     (function
                       (lambda (x)
                         (= (cdr (assoc 0 (entget x))) "MTEXT")
                         ) ;_ end of lambda
                       ) ;_ end of function
                     selset
                     ) ;_ end of vl-remove-if
            ) ;_ end of setq
      (foreach ent mtext
        (vl-catch-all-apply
          (function
            (lambda ()
              (setq pt    (cdr (assoc 10 (entget ent)))
                    align (cdr (assoc 71 (entget ent)))
                    lines ((lambda (/ lst)
                             (setq lst (vl-remove-if-not
                                         (function
                                           (lambda (x)
                                             (cdr (assoc "dist" x))
                                             ) ;_ end of LAMBDA
                                           ) ;_ end of function
                                         (mapcar
                                           (function
                                             (lambda (x / c)
                                               (setq c (vlax-curve-getclosestpointto x pt))
                                               (list
                                                 (cons "dist"
                                                       (if (equal (cadr pt) (cadr c) 1e-6)
                                                         (distance pt c)
                                                         ) ;_ end of if
                                                       ) ;_ end of cons
                                                 (cons "l" (> (car pt) (car c)))
                                                 (cons "ent" x)
                                                 (cons "pt" c)
                                                 ) ;_ end of list
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                           selset
                                           ) ;_ end of mapcar
                                         ) ;_ end of vl-remove-if-not
                                   ) ;_ end of setq
                             (list (car (vl-sort
                                          (vl-remove-if-not '(lambda (a) (cdr (assoc "l" a))) lst)
                                          (function
                                            (lambda (a b)
                                              (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b)))
                                              ) ;_ end of lambda
                                            ) ;_ end of function
                                          ) ;_ end of vl-sort
                                        ) ;_ end of vl-sort
                                   (car (vl-sort
                                          (vl-remove-if '(lambda (a) (cdr (assoc "l" a))) lst)
                                          (function
                                            (lambda (a b)
                                              (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b)))
                                              ) ;_ end of lambda
                                            ) ;_ end of function
                                          ) ;_ end of vl-sort
                                        ) ;_ end of car
                                   ) ;_ end of list
                             ) ;_ end of lambda
                           )
                    ent_l (car (vl-remove-if-not (function (lambda (x) (cdr (assoc "l" x)))) lines))
                    ent_r (car (vl-remove-if (function (lambda (x) (cdr (assoc "l" x)))) lines))
                    ins   (cond
                            ((member align '(1 4 7))
                             (list (+ (cadr (assoc "pt" ent_l)) off)
                                   (cadr pt)
                                   ) ;_ end of list
                             )
                            ((member align '(2 5 8))
                             (list (* 0.5 (apply '+ (mapcar '(lambda (x) (cadr (assoc "pt" x))) (list ent_l ent_r))))
                                   (cadr pt)
                                   ) ;_ end of list
                             )
                            ((member align '(3 6 9))
                             (list (- (cadr (assoc "pt" ent_r)) off)
                                   (cadr pt)
                                   ) ;_ end of list
                             )
                            ) ;_ end of cond
                    w     (- (apply 'distance (mapcar '(lambda (x) (cdr (assoc "pt" x))) (list ent_l ent_r))) (* 2. off))
                    ent   (vlax-ename->vla-object ent)
                    ) ;_ end of setq
              (vla-put-insertionpoint ent (vlax-3d-point ins))
              (vla-put-width ent w)
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Код особо не тестировал.

[PlayKid]

Хм.. Спасибо. Только сразу не разобрался, потому что смутило такое количество "защит от ошибок", тут и повсеместная проверка типа, и обработчик прерываний и другое, запутался сперва. Конечно если рассматривать этот код как код для отдельной конкретной задачи, то мне кажется, что это все немного за лишнее, но если использовать части функций отдельно в других задачах, то конечно да, залишним никогда не бывает.
Смущает правда один момент(по незнанию): переопределение *error*.
Насколько я понял, все функции загружаются сразу, еще до их вызова т.е. я не использовал вызов данного конкретного лиспа, но в памяти АвтоКада уже эта функция (*error*) переопределена и для других лиспов, или она действует только локально, только для этого? Если у меня уже существует переопределение этой функции, не изменит ли она эти переопределения?
Честно признаюсь поиск не мучал, а в книге Полещука ответ не нашел(кроме того что надо сохранять и восстанавливать "прошлое" состояние для этой функции).

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

Посмотри http://www.arcada.com.ua/forum/viewtopic.php?t=445

[PlayKid]

Посмотрел.
Все встало на свои места, кроме того, еще посмотрел вот это:
http://geol-dh.narod.ru/spds/func-is-in-contour.html
В связи с этим я уже знаю что и как буду делать.
Спасибо тебе за помощь, а то мне чего-то очень не нравиться использовать команды АвтоКада в лиспах.

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

И правильно "не нравится" Командами далеко не все можно сделать