Author Topic: Find the polyline around a text  (Read 1033 times)

0 Members and 1 Guest are viewing this topic.

civil.eng

  • Newt
  • Posts: 66
Find the polyline around a text
« on: September 03, 2022, 04:28:11 AM »
Hello everyone,
Long before, someone had given me a function to select a text inside of a polygon, now I need the opposite of it that way I can find the polygon (Entity name of it) for a selected text.
I know a way that it's can be done by "Cadr (Entsel text)" and then creating a boundary for the point , but I need the get the entity name of the main boundary around the text.

Thanks in advance.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Find the polyline around a text
« Reply #1 on: September 03, 2022, 09:36:40 AM »
Upon obtaining the insertion point of the text object, you can use either a ray casting algorithm or winding algorithm to determine within which of the candidate polylines it resides - you may wish to refer to this thread.



Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: Find the polyline around a text
« Reply #2 on: September 03, 2022, 10:05:33 AM »
A common method is ray tracing, counting the number of intersection with the polyline segments. Even number of intersections means that the tested point is outside,
It fails in some particular situations because the considered ray may lie exactly on a vertex of the polyline.
My idea is to apply this method 4 times, aiming some random points near the polyline's boundingbox corners.
If at least 3 of these 4 points returns Odd number of intersections, consider the point inside.
I'm using this method quite often and it never fails.

Code - Auto/Visual Lisp: [Select]
  1. (defun _get_surrounding_polylines (ss / get_points is_inside_p i en el ob border_list a1 a3 a lp str pt lt text res)
  2.   ;Get list of polyline vertexes.
  3.   ;Bulged segments are refined with points at max. 5° apart
  4.   (defun get_points (e / a b p q n d l a1)
  5.     (setq e (vlax-ename->vla-object e)
  6.           a (vlax-curve-getstartparam e)
  7.           b (vlax-curve-getendparam e)
  8.           )
  9.     (while (< a b)
  10.             q (atan (abs (vla-getbulge e a)))
  11.             n (fix (/ (* 80 q) pi))
  12.             a1 a
  13.       )
  14.       (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
  15.       (if
  16.         (> n 0)
  17.         (repeat (1- n)
  18.           (setq a1 (+ a1 (/ 1.0 n))
  19.                 p (vlax-curve-getpointatparam e a1)
  20.           )
  21.           (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
  22.         )
  23.       )
  24.       (setq a (1+ a))
  25.     )
  26.     l
  27.   )
  28.  
  29.   ;check if point pt is inside border l1
  30.   (defun is_inside_p (pt l1 a1 a3 / a2 a4 da l2)
  31.     (setq
  32.           da (mapcar '* (mapcar '- a3 a1) '(0.056124 0.0436521));offset boundingbox corners by random distances
  33.           a1 (mapcar '- a1 da)
  34.           a3 (mapcar '+ a3 da)
  35.           a2 (list (car a3) (cadr a1))
  36.           a4 (list (car a1) (cadr a3))
  37.           l2 (cons (last l1) l1)
  38.     )
  39.     (>
  40.       (apply '+
  41.         (mapcar
  42.          '(lambda (corner)
  43.             (rem
  44.               (apply '+
  45.                 (mapcar
  46.                   '(lambda (vertex1 vertex2)
  47.                      (if (inters pt corner vertex1 vertex2) 1 0)
  48.                    )
  49.                    l1 l2
  50.                 )
  51.               )
  52.               2
  53.             )
  54.           )
  55.           (list a1 a2 a3 a4)
  56.         )
  57.       )
  58.       2.0
  59.     )
  60.   )
  61.  
  62.  (if
  63.     ss
  64.     (progn
  65.       (setq lt nil lp nil res nil)
  66.       (repeat (setq i (sslength ss))
  67.         (setq i (1- i)
  68.               en (ssname ss i)
  69.               el (entget en)
  70.               ob (cdr (assoc 0 el))
  71.         )
  72.         (cond
  73.           ((eq ob "LWPOLYLINE")
  74.            (setq border_list (get_points en)
  75.                  a1 (apply 'mapcar (cons 'min border_list))
  76.                  a3 (apply 'mapcar (cons 'max border_list))
  77.            )
  78.            (setq lp (cons (list en border_list a1 a3) lp))
  79.           )
  80.           ((wcmatch ob "*TEXT")
  81.            (setq str (cdr (assoc 1 el))
  82.                  pt  (cdr (assoc
  83.                            (if
  84.                              (or
  85.                                (eq ob "MTEXT")
  86.                                (and
  87.                                  (zerop (cdr (assoc 72 el)))
  88.                                  (zerop (cdr (assoc 73 el)))
  89.                                )
  90.                              )
  91.                              10
  92.                              11
  93.                            )
  94.                            el
  95.                          )
  96.                      )
  97.                  pt (list (car pt) (cadr pt))
  98.            )
  99.            (setq lt (cons (list pt str en) lt))
  100.           )
  101.         )
  102.       )
  103.       (foreach pl lp
  104.         (if
  105.           (setq text
  106.             (vl-some
  107.              '(lambda (x)
  108.                 (if
  109.                   (and
  110.                     (vl-every '< (caddr pl) (car x) (cadddr pl))
  111.                     (is_inside_p (car x) (cadr pl) (caddr pl) (cadddr pl))
  112.                   )
  113.                   x
  114.                 )
  115.               )
  116.               lt
  117.             )
  118.           )
  119.           (progn
  120.             (setq lt (vl-remove text lt))
  121.             (setq res (cons (list (cadr text) (car pl)) res));to get (string <pline_ename>)
  122. ;;;            (setq res (cons (list (caddr text) (car pl)) res));to get (<text_ename> <pline_ename>)
  123.           )
  124.         )
  125.       )
  126. ;;;      (setq i 1)
  127. ;;;      (foreach x res
  128. ;;;        (mapcar '(lambda (x) (vla-put-color (vlax-ename->vla-object x) i)) x)
  129. ;;;        (setq i (1+ i))
  130. ;;;      )
  131.       res
  132.     )
  133.   )
  134. )

Code - Auto/Visual Lisp: [Select]
  1. (_GET_SURROUNDING_POLYLINES (ssget '((0 . "*TEXT,LWPOLYLINE"))))
  2.  
  3. (("AS71" <Entity name: 2753a414ce0>)
  4. ("BN047" <Entity name: 2753a414cf0>)
  5. ("TT107" <Entity name: 2753a414d00>)
  6. ("{\\fCalibri|b0|i0|c0|p34;S\\fArial|b0|i0|c0|p34;\\C1;94}" <Entity name: 2753a414d10>)
  7. )

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Find the polyline around a text
« Reply #3 on: September 03, 2022, 08:21:16 PM »
If you draw a random line say vertically from text can use (ssget "F" and get objects that line touches then use intersectwith to get a object and distance from text point, so a simple sort based on dist is the closest object and the one you want. Use extmax to get say maximum Y value for drawing the line.

((dist1 ent1)(dist2 ent2)..........)
A man who never made a mistake never made anything

mhupp

  • Bull Frog
  • Posts: 250
Re: Find the polyline around a text
« Reply #4 on: September 04, 2022, 12:42:49 AM »
You could make a selection of the polylines.
then use their cords with (ssget "_WP")  if text selected is in selection = inside polyline.
"_WP" would be fully inside
"_CP" would just need to be crossing or fully inside.

Code - Auto/Visual Lisp: [Select]
  1. ;;----------------------------------------------------------------------------;;
  2. ;; Test for entity Inside Polyline
  3. (defun C:IP (/ ss ss1 ss2 ent poly cords)
  4.   (setq ss2 (ssadd))
  5.   (setq ent (car (entsel "\nSelect Entity")))
  6.   (setq ss (ssget "_X" '((0 . "*polyline")(410 . "Model"))))
  7.   (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  8.     (setq ss1 nil)
  9.     (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget poly))))
  10.     (if (and (setq ss1 (ssget "_WP" cords)) (member ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))))
  11.       (ssadd poly ss2)
  12.     )
  13.   )
  14.   (if (> (sslength ss2) 0)
  15.     (sssetfirst nil ss2)
  16.   )
  17.   (princ)
  18. )