alanjt Posted August 2, 2010 Share Posted August 2, 2010 Alan,Great work. Exactly what I need. Thanks for your help and patience. You're welcome. Quote Link to comment Share on other sites More sharing options...
kuttik Posted March 28, 2014 Share Posted March 28, 2014 OK so lets assume 6 texts are available in drawing A B C D E F .. A and B are close each other for example between distance is 10 and C and D are close each other for example between distance is 15 but both of them are far from A and B.. E and F are close each other and below of A-B and C-D texts. So lisp can be updated to combine A and B , C and D , E and F seperately when we select all of them in rectangular area?I mean not select one by one , when we select area lisp automatically selects texts which are close each other by defined distance ( for example 15) and combine them. Quote Link to comment Share on other sites More sharing options...
kuttik Posted March 31, 2014 Share Posted March 31, 2014 I searched all forum topics still I couldnt how to solve Quote Link to comment Share on other sites More sharing options...
Snownut Posted March 31, 2014 Share Posted March 31, 2014 Try these.... http://www.theswamp.org/index.php?topic=41223.msg463760#msg463760 there are a couple here. Quote Link to comment Share on other sites More sharing options...
kuttik Posted March 31, 2014 Share Posted March 31, 2014 Actually I found that link , and i followed that topic and i have reached other topic link. And at last I have found one lisp, but that lisp as I understood automatically merge 2 texts which close each other as 2x height value of text. Thats ok . But lisp searches texts by Y alignment. I mean I select 2 texts in same horizontal line, lisp doesnt merge them. But if I select 2 texts in same or different vertical line ( within related distance 2xheight value ) lisp can merge texts. Which string should I change to make lisp can merge texts by X alignment not Y . I want to merge texts which are closer more than 2xheight value in horizontal line Here is code that I found ;; AUTHOR ;;; Copyright© 2010 Ron Perez (ronperez@gmail.com) ;;; 11.02.2010 added grouping text by X values (defun c:t2mt (/ rjp-removextraspaces rjp-ent2obj rjp-getbbwdth rjp-getbbtlc rjp-dxf d doc elst hgt i n nxt obj otxt out pt ss txt w x x_sort y ) (vl-load-com) (defun rjp-removextraspaces (txt) (while (vl-string-search " " txt) (setq txt (vl-string-subst " " " " txt))) txt ) (defun rjp-ent2obj (ent) (if (= (type ent) 'ename) (vlax-ename->vla-object ent) ent ) ) (defun rjp-dxf (code ent) (if (and ent (= (type ent) 'ename)) (cdr (assoc code (entget ent))) ) ) (defun rjp-getbb (ent / ll ur) (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur) (mapcar 'vlax-safearray->list (list ll ur)) ) (defun rjp-getbbwdth (ent / out) (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent)))) (abs (- (car out) (cadr out))) ) (defun rjp-getbbtlc (ent / out) (setq out (rjp-getbb (rjp-ent2obj ent))) (list (caar out) (cadr (last out)) 0.0) ) (if (and (setq ss (ssget ":L" (list '(0 . "text")))) (setq doc (vla-get-activedocument (vlax-get-acad-object))) ;;list as X Y TEXT ENAME (setq elst (mapcar '(lambda (x) (list (car (rjp-dxf 10 x)) (cadr (rjp-dxf 10 x)) (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ") x ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) ) (progn ;;Sort top to bottom (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2))))) ;;Group by x values using text height as fuzz value (while (setq i (car elst)) (setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst)) (mapcar '(lambda (x) (setq elst (vl-remove x elst))) y) (setq x_sort (cons y x_sort)) ) (foreach item x_sort (setq ;;Get widest piece of text to set mtext width w (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>))) hgt (rjp-dxf 40 (last (car item))) pt (rjp-getbbtlc (last (car item))) ;;Grab top text to pull properties from otxt (vlax-ename->vla-object (last (car item))) ) ;;Puts hard returns for text spaced greater than (* 2. hgt) (setq n 0) (foreach x item (if (setq nxt (nth (setq n (1+ n)) item)) (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt)) (setq out (cons (strcat (caddr x) "\\P\\P") out)) (setq out (cons (caddr x) out)) ) (setq out (cons (caddr x) out)) ) ) ;;Join the text into one string (setq txt (apply 'strcat (reverse out))) ;;Insert mtext (setq obj (vla-addmtext (if (= (getvar 'cvport) 1) (vla-get-paperspace doc) (vla-get-modelspace doc) ) (vlax-3d-point pt) w txt ) txt nil out nil ) ;;Match properties from top text object (vla-put-height obj (vla-get-height otxt)) (vla-put-attachmentpoint obj actopleft) (vlax-put obj 'insertionpoint pt) (vla-put-rotation obj 0.0) (vla-put-layer obj (vla-get-layer otxt)) (vla-put-stylename obj (vla-get-stylename otxt)) ;;Delete selected single line text (mapcar 'entdel (mapcar 'last item)) ) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.