Тема: Определение координат центра ячейки таблицы
Здравствуйте!!
Собственно, вопрос в топике - нужно определить координаты центра ячейки в таблице по getpoint в этой самой ячейке.
Кто знает, подскажите пожалуйста способ.
Спасибо!
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Определение координат центра ячейки таблицы
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте!!
Собственно, вопрос в топике - нужно определить координаты центра ячейки в таблице по getpoint в этой самой ячейке.
Кто знает, подскажите пожалуйста способ.
Спасибо!
Если ваша таблица создана из отрезков или полилиний, то можно посмотреть сюда:
https://www.caduser.ru/forum/topic20466.html
Спасибо, Владимир, я уже смотрел ту тему, к сожалению не мой случай - у меня таблица автокадовская, и BOUNDARY к сожалению не применить :(
> Нюк
Тогда проще:
(defun GetCellCenter (/ atable cnt col cpt en ent hgt np p1 p3 p4 pickpt return row wid xp ) (vl-load-com) (if (and (setq ent (entsel "\n >> Select table >> \n")) (eq "ACAD_TABLE" (cdr (assoc 0 (entget (setq en (car ent)) ) ) ) ) ) (progn (setq atable (vlax-ename->vla-object (car ent)) pickpt (vlax-3d-point (trans (getpoint "\n >> Pick point inside of the desired cell >>" ) 1 0 ) ) return (vla-hittest atable pickpt (vlax-3D-Point '(0. 0. 1.)) 'row 'col ) ) (vla-getboundingbox atable 'np 'xp) (setq p1 (vlax-safearray->list np) p3 (vlax-safearray->list xp) p4 (list (car p1) (cadr p3) 0.0) ) (setq hgt 0 cnt 0 ) (repeat row (setq hgt (+ hgt (vla-getrowheight atable cnt))) (setq cnt (1+ cnt)) ) (setq hgt (+ hgt (/ (vla-getrowheight atable cnt) 2))) (setq wid 0 cnt 0 ) (repeat col (setq wid (+ wid (vla-getcolumnwidth atable cnt))) (setq cnt (1+ cnt)) ) (setq wid (+ wid (/ (vla-getcolumnwidth atable cnt) 2))) (setq cpt (list (+ (car p4) wid) (- (cadr p4) hgt) 0.0)) ) ) cpt ) ;; TesT : (setq center_point (GetCellCenter)) (alert (vl-princ-to-string center_point))
~'J'~
А вот так (отмечаем точки по диагонали ячейки):
Command: (getpoint) _m2p First point of mid: Second point of mid: (183.382 182.659 0.0)
> Нюк
Посмотри здесь: https://www.caduser.ru/forum/topic25081.html
Все что для тебя там есть чтобы определить номер колонки и строки ячейки. Затем (vla-getcellextents tbl row col 0) для получения размеров ячейки. Ну а дальше дело техники.
Вариант без указания таблицы
;;======================================================;; ;; written by Fatty The Old Horse 10/13/05 ;; ;; (framework) ;; ;;======================================================;; ;; helper functions ;; ;; group list by number (defun group-by-num (lst num / ls ret) (if (= (rem (length lst) num ) 0) (progn (setq ls nil) (repeat (/ (length lst) num) (repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) (setq ret (append ret (list (reverse ls))) ls nil)))) ret) (defun C:TEST ( ) (if (and ;_Проверяем, попала ли точка в ячейку таблицы (setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset))))) (setq pt (getpoint "\n >> Pick point inside of the desired cell >>")) (setq pt (vlax-3d-point(trans pt 1 0))) (mapcar '(lambda (x) (or tblobj (and (= :vlax-true (vla-HitTest x pt (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)) 'row 'col)) (setq tblobj x) ) ) ) lst) tblobj row col ) (progn (setq cell (group-by-num(vlax-safearray->list(vlax-variant-value(vla-getcellextents tblobj row col 0))) 3)) (setq center_point (mapcar '(lambda(x y)(* 0.5 (+ x y)))(car cell)(last cell))) (alert (vl-princ-to-string center_point)) ) (alert "Not a table in this place") ) )
;;;Использование
TEST
> Владимир Громов
> Fatty
> VVA
Все получилось, всем большое спасибо!
Вариант без указания таблицы
;;======================================================;; ;; written by Fatty The Old Horse 10/13/05 ;; ;; (framework) ;; ;;======================================================;; ;; helper functions ;; ;; group list by number (defun group-by-num (lst num / ls ret) (if (= (rem (length lst) num ) 0) (progn (setq ls nil) (repeat (/ (length lst) num) (repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) (setq ret (append ret (list (reverse ls))) ls nil)))) ret) (defun C:TEST ( ) (if (and ;_Проверяем, попала ли точка в ячейку таблицы (setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset))))) (setq pt (getpoint "\n >> Pick point inside of the desired cell >>")) (setq pt (vlax-3d-point(trans pt 1 0))) (mapcar '(lambda (x) (or tblobj (and (= :vlax-true (vla-HitTest x pt (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)) 'row 'col)) (setq tblobj x) ) ) ) lst) tblobj row col ) (progn (setq cell (group-by-num(vlax-safearray->list(vlax-variant-value(vla-getcellextents tblobj row col 0))) 3)) (setq center_point (mapcar '(lambda(x y)(* 0.5 (+ x y)))(car cell)(last cell))) (alert (vl-princ-to-string center_point)) ) (alert "Not a table in this place") ) )
Использовал код описанный выше в своём листинге
(defun group-by-num (lst num / ls ret) (if (= (rem (length lst) num ) 0) (progn (setq ls nil) (repeat (/ (length lst) num) (repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) (setq ret (append ret (list (reverse ls))) ls nil)))) ret) (defun group-by-num (lst num / ls ret) (if (= (rem (length lst) num ) 0) (progn (setq ls nil) (repeat (/ (length lst) num) (repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) (setq ret (append ret (list (reverse ls))) ls nil)))) ret) (defun c:tablepoz () (vl-load-com) (if (and ;_Проверяем, попала ли точка в ячейку таблицы (setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset))))) (setq pt (getpoint "\n >> Укажите ячейку таблицы >>")) (setq pt (vlax-3d-point(trans pt 1 0))) (mapcar '(lambda (x) (or tblobj (and (= :vlax-true (vla-HitTest x pt (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)) 'row 'col)) (setq tblobj x) ) ) ) lst) tblobj row col ) (progn (setq text_obj (vlax-ename->vla-object (car(entsel "\n >> Укажите текст позиции для связи с таблицей >>")))) (setq text_string (vla-get-TextString text_obj)) (setq objiD (vl-princ-to-string (vla-get-objectid tblobj))) (setq rown (vl-princ-to-string (+ row 1))) (setq prefix (substr text_string 1 4)) ; (alert prefix) ;(princ prefix) (setq mv nil) (setq text_poz_table "false") (setq mv (cond ((= prefix "По") (setq text_poz_table (strcat "%%UПоз. " "%<\\AcExpr (Table(%<\\_ObjId " objiD ">%).A" rown ")>%"))) ((= prefix "%%UП") (setq text_poz_table (strcat "%%UПоз. " "%<\\AcExpr (Table(%<\\_ObjId " objiD ">%).A" rown ")>%"))) ((= prefix "{\\LП") (setq text_poz_table (strcat "{\\LПоз. " "%<\\AcExpr (Table(%<\\_ObjId " objiD ">%).A" rown ")>%" "}"))) (T "false") ) ) (if (= mv "false")(setq text_poz_table (strcat "%<\\AcExpr (Table(%<\\_ObjId " objiD ">%).A" rown ")>%"))) (vla-put-TextString text_obj text_poz_table) ) (alert "В этом месте нет таблицы") ) (princ) );end of defun
При неоднократном использование начинает выдавать vla указатель tblobj на другую таблицу.
Разобраться не могу. Указываю таблицу - строку и столбец возвращает правильно, а вот tblobj
с другой!
(defun c:tablepoz ()
Нужно задать все переменные как локальные
после косой черты в начале команды:
(defun c:tablepoz (/ f d c d e f g h)
.........
~'J'~
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Определение координат центра ячейки таблицы
Форум работает на PunBB, при поддержке Informer Technologies, Inc