Lisp to loop through all polylines and let me know which ones do not have a text entity justified to MC inside of it

Lisp to loop through all polylines and let me know which ones do not have a text entity justified to MC inside of it

vporrash141089
Advocate Advocate
1,986 Views
24 Replies
Message 1 of 25

Lisp to loop through all polylines and let me know which ones do not have a text entity justified to MC inside of it

vporrash141089
Advocate
Advocate

Hi everyone,

 

I'm working on a large set of files for which I need to verify that the mc justification of the unique text entity is  within the polyline, if there are text mc not within the polyline then I would change these to color red, appreciate all the help possible and thanks in advance for all your help!

 

I was thinking that the routine could loop through all polylines and after it ends let me know which ones did not have a text entity.

 

Regards,

 

0 Likes
Accepted solutions (2)
1,987 Views
24 Replies
Replies (24)
Message 21 of 25

john.uhden
Mentor
Mentor

@vporrash141089 

I forgot to ask...

Does any of the polylines have bulged (arc) segments?  If not then I think @ВeekeeCZ 's response is a winner.

If so, then we all have a lot more work to put into this.

Also, is there a fuzz factor to determine if a text object is "close enough" to be treated as "inside?"  And what if the text falls exactly on the polyline boundary?  Which reminds us of the question... "if a plane crashes on the US-Canadian border, where do they bury the survivors?" 🙄

John F. Uhden

0 Likes
Message 22 of 25

vporrash141089
Advocate
Advocate

While trying @ВeekeeCZ program I did notice it highlitghted the arc segments even if the mc text was inside of it completely, I thought it is no big deal. Since these are red I get to double check on them as well and I already know it is a minor issue with the tool. 

 

I think I got one polyline that had the textmc point right at the center in that case it did not highlight it red but again this happens very few times.

 

If there is more work to make it perfect but it would take too long i'd say you have helped enough so far, though I'd appreciate offcourse.

 

Thanks everyone! 

 

 

0 Likes
Message 23 of 25

ВeekeeCZ
Consultant
Consultant

First of all, I have no desire to make a 'perfect' tool. Just offer some tool that could help and would be good just enough to serve its purpose. 

 

I did my homework, and I did check your sample beforehand and -- found a couple of rounded-looking segments - but those all were linearized. So I assumed that there was no need to consider bulges. So, the routine thus completely ignores them - it considers them as straight.


However, Express Tools offers a function that you can play with - it linearizes arcs based on the specified precision. Higher precision, slower performance. See below.

Another simple solution would be checking the polylines for bulges and if there are any, simply mark them in a different color.

 

I think I got one polyline that had the textmc point right at the center in that case it did not highlight it red but again this happens very few times.

If you want an explanation or fix, you need to post the dwg.

 

;; REQUIRES EXPRESS TOOLS
(vl-load-com) (defun c:MCOutside ( / *error* LM:UniqueFuzz s a z i s w e m) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end")) (princ (strcat "\nError: " errmsg))) (if z (command-s "_zoom" "_p")) (setvar 'cmdecho 1) (if a (mapcar 'entdel a)) (princ)) ;; Lee Mac - http://www.lee-mac.com/uniqueduplicate.html#uniquefuzz (defun LM:UniqueFuzz ( l f ) (if l (cons (car l) (LM:UniqueFuzz (vl-remove-if (function (lambda ( x ) (equal x (car l) f))) (cdr l)) f)))) (if (and (setq s (ssget "_X" '((0 . "LWPOLYLINE") (8 . "SPACE") (410 . "Model")))) (setq a (ssget "_X" '((0 . "TEXT") (8 . "SPACENAME") (410 . "Model")))) (setq a (vl-remove-if '(lambda (x) (/= 1 (cdr (assoc 72 (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex a))))) (setq a (mapcar '(lambda (x) (entmakex (list '(0 . "POINT") (cons 10 (cdr (assoc 11 (entget x))))))) a)) (setvar 'cmdecho 0) (setq z (vl-cmdf "_.zoom" "_e")) (setq m 0) ) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i)))) (if (or (not (setq w (ssget "_CP" (LM:UniqueFuzz (acet-geom-object-point-list e 1e-4) 1e-6) '((0 . "POINT") (8 . "0"))))) (/= 1 (sslength w))) (progn (setpropertyvalue e "Color" 1) (setq m (1+ m)))))) (if m (princ (strcat (itoa m) " polylines marked."))) (*error* "end") )

 

0 Likes
Message 24 of 25

vporrash141089
Advocate
Advocate

@ВeekeeCZ I'm nor worried about it your first tool does the work and that is all I need... Thank you again!

 

If I may ask how long have you been programming in Lisp? All that code seems very high level to me! 🙂

0 Likes
Message 25 of 25

ВeekeeCZ
Consultant
Consultant
Accepted solution

If you have any knowledge of programming, you won't need more than a few months to get to my level.