Leaderboard

Try this mishmash of routines. I've tried it in a dozen scenarios and point configurations and it seems to work, but I have a feeling I'm missing a case where it might fail. (vl-load-com) (defun rh:emLWP (lst cls) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (x) (cons 10 x))) lst) );end_append );end_entmakex );end_defun (defun rh:mslen (ent / sp ep obj vlst lst msl) (setq sp 0 ep (vlax-curve-getendparam ent) vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (while (< sp ep) (setq lst (cons (list sp (- (vlax-curve-getdistatparam ent (1+ sp)) (vlax-curve-getdistatparam ent sp))) lst) sp (1+ sp))) (setq lst (reverse lst) msl (vl-position (car (vl-sort lst '(lambda (x y) (> (cadr x) (cadr y))))) lst)) (while (not (minusp msl)) (setq vlst (append (cdr vlst) (list (car vlst))) msl (1- msl))) (entdel ent) (rh:emLWP vlst 0) );end_defun (defun _gp ( lst / sp cnt d n z ) (cond (lst (setq d (distance (car lst) (cadr lst)) sp (car lst)) (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (< d (setq n (distance x y))) (setq d n sp x)))) (setq lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) lst)) (rh:mslen (rh:emLWP lst 1)) ) );end_cond );end_defun (defun c:test ( / ss cnt ent elst ipt h_lst h1_lst) (setq ss (ssget '((0 . "TEXT")(8 . "Punkti_kood")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq ent (ssname ss (setq cnt (1- cnt))) elst (entget ent) ipt (cdr (assoc (if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0)) 10 11) elst)) );end_setq (if (= (cdr (assoc 1 elst)) " H") (setq h_lst (cons ipt h_lst)) (setq h1_lst (cons ipt h1_lst))) );end_repeat ) );end_cond (foreach x (list h_lst h1_lst) (if x (_gp x))) (princ) );end_defun

I think you'll find that the insertion point of the text is the same as the centre of the circle (Top Left) and each text is preceeded by a space. The line is a shortest route problem, so you perhaps find the convex hull of each set of points (H & H1) as a starting pint, work from there then remove the longest segment.IIRC the last time this came up was about 1.5 - 2 years ago (no more) on the Autodesk forums

have a look at this (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq oldsnap (getvar 'osmode)) ; save current osnaps (setvar 'osmode 0) ; turn off osnaps (setq ent (entget (car (entsel "\nPick text for layer and value")))) ; select a text obect (setq lay (cdr (assoc 8 ent))) ; get object layer dxf code 8 (setq str (cdr (assoc 1 ent))) ; get object text dxf code 1 (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) ; get objects that are text on layer plus text string (setq lst '()) ; set list to blank in case exists already (repeat (setq x (sslength ss)) ; do for every text in slection (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; get each item in selection set (setq ins (vlax-get Obj 'insertionPoint)) ; get text insertion point (setq rad (* 1.5 (vlax-get Obj 'Height))) ; dummy value for a polygon to look for a nearby Circle (command "polygon" 20 ins "I" rad) ;Autocad Note briscad is different (setq obj2 (entlast)) ; save the name of the last object created (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) ; loops through the pline vertice points (command "erase" obj2 "") ; no longer required as needed points (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) ; looks for circles that touch the polygon (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) ; gets the center point of the circle (setq lst (cons cen lst)) ; makes a list of all the pline points ) (command "_pline") ; start pline command (while (= (getvar "cmdactive") 1) ; is pline running (repeat (setq x (length lst)) ; repeat for all the points (command (nth (setq x (- x 1)) lst)) ; pass the point co-ords to the pline command ) (command "") ; end pline ) (setvar 'osmode oldsnap) ; reset the osnaps (princ) ; quite exit of defun )

The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn. My attempt ; simple join circles next to text. ; by Alan H April info@alanh.com.au (defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X) (setq offd 0.1) ; change to (setq offd (getreal "\nEnter offset")) if text is further away (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ent (entget (car (entsel "\nPick text for layer and value")))) (setq lay (cdr (assoc 8 ent))) (setq str (cdr (assoc 1 ent))) (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) (setq lst '()) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins (vlax-get Obj 'insertionPoint)) (setq rad (* 1.5 (vlax-get Obj 'Height))) (command "polygon" 20 ins "I" rad) ;Autocad (setq obj2 (entlast)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) (command "erase" obj2 "") (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) (setq lst (cons cen lst)) ) (command "_pline") (while (= (getvar "cmdactive") 1) (repeat (setq x (length lst)) (command (nth (setq x (- x 1)) lst)) ) (command "") ) (setvar 'osmode oldsnap) (princ) )

Something like this? (defun c:textcircle ( / circles dets ent i pl ss texts txt unique) (defun unique (lst / rtn) (while lst (setq rtn (cons (car lst) rtn) lst (vl-remove (car lst) lst) ) ) (reverse rtn) ) (if (setq ss (ssget '((0 . "CIRCLE,TEXT,MTEXT")))) (progn (repeat (setq i (sslength ss)) (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "CIRCLE") (setq circles (cons ent circles)) (setq texts (cons ent texts)) ) ) (foreach x circles (if (setq txt (car (vl-member-if '(lambda (y) (equal (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget y))) 1e-8 ) ) texts ) ) ) (setq dets (cons (cons (cdr (assoc 1 (entget txt))) x) dets)) ) ) (foreach x (unique (mapcar 'car dets)) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") ) (list (cons 90 (length (setq pl (vl-remove-if-not '(lambda (y) (eq x (car y))) dets))))) (apply 'append (mapcar '(lambda (y) (list (assoc 10 (entget (cdr y))) '(40 . 0) '(41 . 0) '(42 . 0) '(91 . 0) ) ) pl ) ) ) ) ) ) ) (princ) )