0 Members and 1 Guest are viewing this topic.
(defun C:t2t(/ acsp atable col data get-contents pp rem-dups row ) (vl-load-com)(defun rem-dups (mylist / newlst) ;; remove duplicates ;; as published by hutch (foreach item mylist (and (null (member item newlst)) (setq newlst (cons item newlst)) ) ) newlst)(defun get-contents (/ data en i ip output p1 p2 rowlist ss tmp txt ylist) (setq data nil);debug only (alert "Select text by window selection") (setq p1 (getpoint "\nSpecify the first corner point: >> ") p2 (getcorner p1 "\nSpecify the opposite corner point: >> ") ) (setq ss (ssget "W" (list (car p1)(cadr p1)) (list (car p2)(cadr p2)) (list (cons 0 "TEXT"))) i -1 ) (repeat (sslength ss) (setq en (ssname ss (setq i (1+ i))) ip (cdr (assoc 10 (entget en))) txt (cdr (assoc 1 (entget en))) tmp (cons txt ip) data (cons tmp data) ) ) (setq ylist (mapcar 'caddr data) ylist (rem-dups ylist) ylist (vl-sort ylist (function (lambda (a b) (> a b)))) ) (repeat (length ylist) (setq rowlist (vl-remove-if-not (function (lambda (x) (equal (caddr x) (car ylist) 0.1) ) ) data ) rowlist (vl-sort rowlist (function (lambda (a b) (< (cadr a) (cadr b)))) ) ) (setq output (append output (list rowlist))) (setq ylist (cdr ylist)) ) (setq output (mapcar (function (lambda (x) (mapcar 'car x) ) ) output ) ) (reverse (rem-dups output)));;---------------------------------------------------;;(setq data(get-contents))(setq acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) ) (setq pp (getpoint "\nPick insertion point for table: "));;; add the new table (setq atable (vla-addtable acsp (vlax-3d-point pp) (+ 2 (length data))(length (car data)) 300 1500)) (setq row 2) (foreach item data (setq col 0) (vla-setcelldatatype atable row col 0 acDataRow) (foreach x item (vla-settext atable row col x) (vla-settextheight2 atable row col 0 200); text height 200 (vla-setcellalignment atable row col acMiddleCenter) (setq col (1+ col))) (setq row (1+ row)))(vla-deleterows atable 0 2);delete first 2 rows(princ))