Тема: Определение координат центра ячейки таблицы

Здравствуйте!!
Собственно, вопрос в топике - нужно определить координаты центра ячейки в таблице по getpoint в этой самой ячейке.
Кто знает, подскажите пожалуйста способ.
Спасибо!

Re: Определение координат центра ячейки таблицы

Если ваша таблица создана из отрезков или полилиний, то можно посмотреть сюда:
https://www.caduser.ru/forum/topic20466.html

Re: Определение координат центра ячейки таблицы

Спасибо, Владимир, я уже смотрел ту тему, к сожалению не мой случай - у меня таблица автокадовская, и BOUNDARY к сожалению не применить :(

Re: Определение координат центра ячейки таблицы

> Нюк
Тогда проще:

(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'~

Re: Определение координат центра ячейки таблицы

А вот так (отмечаем точки по диагонали ячейки):

Command: (getpoint)
_m2p First point of mid: Second point of mid:
(183.382 182.659 0.0)

Re: Определение координат центра ячейки таблицы

> Нюк
Посмотри здесь: https://www.caduser.ru/forum/topic25081.html
Все что для тебя там есть чтобы определить номер колонки и строки ячейки. Затем (vla-getcellextents tbl row col 0) для получения размеров ячейки. Ну а дальше дело техники.

Re: Определение координат центра ячейки таблицы

Вариант без указания таблицы

;;======================================================;;
;;  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

Re: Определение координат центра ячейки таблицы

> Владимир Громов

> Fatty

> VVA
Все получилось, всем большое спасибо!

Re: Определение координат центра ячейки таблицы

Вариант без указания таблицы

;;==================================================­====;;
;;  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
с другой!

Re: Определение координат центра ячейки таблицы

Что я делаю не так?

Re: Определение координат центра ячейки таблицы

Василий Черников пишет:

(defun c:tablepoz ()

Нужно задать все переменные как локальные
после косой черты в начале команды:

(defun c:tablepoz (/ f d c d e f g h)


.........

~'J'~