[antiponf]

Нужен Лисп для копирование из одного столбца таблицы в другую таблицу текста до первой точки или запятой. Имеется 2 таблицы, нажимаем кнопку, выбираем столбец таблицы, выбираем столбец другой таблицы, жмем enter и все данные копируются из одного столбца в другой, причем текст каждой ячейки копируется до первой точки или запятой.
Заранее благодарен.

[Дима_]

Offtop: Иш захотел...

[antiponf]

я просто ничего не понимаю в лиспе. Скажите это не возможно?

[Дима_]

Возможно, просто если выбирать столбец запросом цифры (его номера), то это на 3 минуты кодить - но работать не удобно, а если выбирать мышкой - то надо использовать "заднепроходные" методы определения, что ты выбрал (с учетом всевозможных конфигураций столбцов) - т.к. API для выбора столбца (ячеек) таблицы ни в лиспе, ни в объектной модели нет.
p/s/ что то меня никто не поправил, на выбранный (штатно) столбец-то нет, а про HitTest я что-то упустил, ну да бог с ним.

[antiponf]

Можно и цифрой. мне не часто это делать нужно, но каждый раз длинные таблицы копировать это проблема

[Дима_]

Код:

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

 (vl-load-com)
(defun c:table-text-copy()
  ((lambda (strim-list)
     ((lambda (t1 c1 t2 c2)
        ((lambda (rowcount)
           ((lambda (frec doc)
              (vla-startundomark doc)
              (frec 1)
              (vla-endundomark doc))
            (lambda (row)
              (if (> rowcount row)
                  (progn (vla-settext t2 row c2 (vl-list->string 
                                                 (strim-list
                                                  (vl-string->list(vla-gettext t1 row c1)))))
                         (frec (1+ row)))))
            (vla-get-activedocument(vlax-get-acad-object))))
         (min (vla-get-rows t1) (vla-get-rows t2))))
      (vlax-ename->vla-object (car (entsel "\n Исходная таблица ")))
      (getint "\n Номер столбца ")
      (vlax-ename->vla-object (car (entsel "\n Целевая таблица ")))
      (getint "\n Номер столбца ")))
   (lambda (lst)
     (if lst
         (if (not (or (= (car lst) 46) (= (car lst) 44)))
             (cons (car lst) (strim-list (cdr lst))))))))

Ошибок не проверяет, запускать командой table-text-copy, столбцы считает по программистки - начиная с нуля, первую строку (заголовок) не копирует.
p.s. Чуток исправил.

[antiponf]

спасибо огромное, а вот еще вопрос простите что не в тему, можно сделать лисп чтобы выделенный текст обводился прямоугольником, а над правым углом прямоугольника появлялся мтекст А1

[Дима_]

Offtop: и тут остапа понесло да все можно, лишь бы... текст или тексты?? пример короче нарисуй.

[antiponf]

Кстати, предыдущая программа копирует в другой столбик, но не обрезает текст по первой запятой или точке :-(

[Дима_]

Это я со слепу бегло прочитал и решил что обрезать надо по точке с запятой ; - исправил в #6.

Код:

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

 (vl-load-com)
(defun pln (lst c); создает полилинию по списку вершин lst, c - nil/T - разомкн/замкнт или '(с слой цвет).
  (entmakex (append
             (list (cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline") (cons 90 (length lst)))
             (if (= (type c) 'list)
                 (vl-remove nil (list
                                 (if (car c) (cons 70 1) (cons 70 0))
                                 (if (cadr c) (cons 8 (cadr c)))
                                 (if (caddr c) (cons 62 (caddr c)))
                                 ));end of list & vl-remove
                 (list (if c (cons 70 1) (cons 70 0)))
                 );end of if
             (mapcar '(lambda (x) (cons 10 x)) lst)
             ));end of apend & entmakex
  );end of pln
(defun c:ramka-a1()
  ((lambda (doc lst)
     (vla-startundomark doc)
     (mapcar '(lambda (txt / maxpt minpt)
                (vla-getboundingbox (vlax-ename->vla-object txt) 'maxpt 'minpt)
                ((lambda (pt1 pt2)
                   (pln (list pt1 (cons (car pt1) (cdr pt2)) pt2 (cons (car pt2) (cdr pt1))) T)
                   (entmakex (list '( 0 . "TEXT") (cons 10 (cons (- (car pt2) 4) (cdr pt2))) '(40 . 2.5) '(1 . "A1"))))
                 (vlax-safearray->list maxpt)
                 (vlax-safearray->list minpt)))
             lst)
     (vla-endundomark doc))
   (vla-get-activedocument(vlax-get-acad-object))
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*text"))))))))

Команда ramka-a1 для "настройки" размера шрифта и отступа - строка 23 (цифры 4 и 2.5) - задай сам - вычислять их програмно мне просто лень.

[antiponf]

выбираю текст жму enter и пишет
Error: no function definition: PLN
:-(

[Дима_]

Забыл я про нее - исправил в #10.