How to extract text surrounding selected text in a clockwise direction

[Engineer_Yasser]

 

 

 

How to extract text (yellow text in pic) surrounding selected text (green text in pic) in a clockwise direction

Starting with the text above the selected text

 

The result list should be :

====================

48.39

30.00

43.78

30.00

38.89

11.18

 

Test File.dwg

Edited November 7, 2023 by Engineer_Yasser

[BIGAL]

1st comment 11.175 is missing in lot 564.

 

Getting the text is the easy part. Doing a output in the way you want is complicated.

 

Lee-mac has a nice pline output, that may be useful.

 

 

http://www.lee-mac.com/polyinfo.html

 

[Engineer_Yasser]

@BIGAL

 

Thanks for the reply

As you said it's easy to extract all segments lengths but the challenge here is how to arrange the output clockwise

[fuccaro]

This will process correct only the line segments of the polyline:

(defun c:pp()
  (princ "Select center text")
  (setq c (cadr (entsel)))
  (princ "select polyline")
  (setq pl (entget (car (entsel)))
	points nil txtH 4)	;txtH is the height of the text. Change to suit
  (setq p2 (cdr (assoc 10 (reverse pl))))
  (foreach x pl
    (cond
      ((= 10 (car x)) (setq p1 (cdr x)
			    txt (rtos (* 1.0 (distance p1 p2)))
			    poz1 (mapcar '/ (mapcar '+ p1 p2)  (list 2 2))
			    poz (polar c (angle c poz1) (- (distance c poz1) (* 1.5 txtH)))
			    en (entmake (list '(0 . "TEXT") (cons 1 txt) (cons 10 poz) (cons 40 txtH) (cons 50 (angle p2 p1))))
			    p2 p1
			    ))
      )
    )
  )

 

[Engineer_Yasser]

@fuccaro

 

Thanks for the reply 

 

You didn't get my point ... I already have ( yellow ) segment lengths but I want to extract these texts in a clockwise direction to a list

[fuccaro]

Oh... sorry! I will see lather if I get some time

[BIGAL]

Using Lee-mac code depends on the direction of the pline is it Clockwise or anti clockwise. So easy to check.

[lastknownuser]

First thing you have to know is the center from which you will define cw direction. Here you have a little problem, since the center is usually defined as a polygon centroid. So in some cases the top dimension will not be considered first (image attached to explain better). You could manually pick center if that is an option. Here is the code from Lee Mac, with a little adjustment so the north is start of direction, code from  https://www.theswamp.org/index.php?topic=36854.msg418494#msg418494
EDIT: result here is a list of dimension coordinates, just to mention that
 

(setq ss (ssget (list (cons 0 "TEXT")
		      (cons 8 "-Parcel Dim")
		      (cons 410 (getvar "ctab")))))
(setq n 0)
(setq coord_lst nil)
(while (< n (sslength ss))
  (setq coord (cdr (assoc 10 (entget (ssname ss n)))))
  (setq coord_lst (cons coord coord_lst))
  (setq n (1+ n))
  );while

(setq coord_lst_cw
       ((lambda	(ref 2pi)
	  (vl-sort coord_lst
		   (function
		     (lambda (a b)
		       (> (2pi (- (angle ref a) (/ pi 2)))
			  (2pi (- (angle ref b) (/ pi 2))))))))
	 ((lambda (n)
	    (mapcar '/ (apply 'mapcar (cons '+ coord_lst)) (list n n n)))
	   (float (length coord_lst)))
	 (lambda (a) (rem (+ pi pi a) (+ pi pi))))
      );setq

 

Edited November 7, 2023 by lastknownuser

[Danielm103]

....it was wrong

Edited November 7, 2023 by Danielm103
oof

[fuccaro]

May I try again?

(defun c:pp ()
  (princ "Select center text")
  (setq	c (car (entsel)) cPoz (cdr (assoc 10 (entget c)))
	h (cdr (assoc 40 (entget c))))
  (princ "select polyline")
  (setq	pl     (entget (car (entsel)))
	points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) pl))
  )
  (setq ss (ssget "wp" points '((0 . "TEXT"))))
  (ssdel c ss)
  (setq	txt  nil)
  (repeat (setq i (sslength ss))
    (setq el   (entget (ssname ss (setq i (1- i))))
	  txt  (cons (list (cdr (assoc 1 el))
			   (setq ang (- (/ pi 2.0) (angle cPoz (cdr (assoc 10 el)))))
		     )
		     txt
	       )
    )
  )
  (setq txt (vl-sort txt '(lambda(a b) (< (cadr a) (cadr b))))
	txt1 (mapcar 'abs (mapcar 'cadr txt))
	vmin (apply 'min txt1)
	i (- (length txt) (length (member vmin txt1)))
	p1 (getpoint "start of list"))
  (repeat (length txt)
    (princ (strcat "| " (itoa i) " " (car (nth i txt))))
    (entmake (list '(0 . "TEXT") (cons 1 (car (nth i txt))) (cons 40 h) (cons 10 p1)))
    (setq i (if (< i (1- (length txt))) (1+ i) 0)
	  p1 (mapcar '+ p1 (list 0 (* h -1.5) 0)))
    )  
  )

 

[Danielm103]

fuccaro's answer was better

Edited November 7, 2023 by Danielm103
oof

[Engineer_Yasser]

3 hours ago, fuccaro said:

May I try again?

(defun c:pp ()
  (princ "Select center text")
  (setq	c (car (entsel)) cPoz (cdr (assoc 10 (entget c)))
	h (cdr (assoc 40 (entget c))))
  (princ "select polyline")
  (setq	pl     (entget (car (entsel)))
	points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) pl))
  )
  (setq ss (ssget "wp" points '((0 . "TEXT"))))
  (ssdel c ss)
  (setq	txt  nil)
  (repeat (setq i (sslength ss))
    (setq el   (entget (ssname ss (setq i (1- i))))
	  txt  (cons (list (cdr (assoc 1 el))
			   (setq ang (- (/ pi 2.0) (angle cPoz (cdr (assoc 10 el)))))
		     )
		     txt
	       )
    )
  )
  (setq txt (vl-sort txt '(lambda(a b) (< (cadr a) (cadr b))))
	txt1 (mapcar 'abs (mapcar 'cadr txt))
	vmin (apply 'min txt1)
	i (- (length txt) (length (member vmin txt1)))
	p1 (getpoint "start of list"))
  (repeat (length txt)
    (princ (strcat "| " (itoa i) " " (car (nth i txt))))
    (entmake (list '(0 . "TEXT") (cons 1 (car (nth i txt))) (cons 40 h) (cons 10 p1)))
    (setq i (if (< i (1- (length txt))) (1+ i) 0)
	  p1 (mapcar '+ p1 (list 0 (* h -1.5) 0)))
    )  
  )

 

 

 

Very nice work .. it is working perfectly    .. Thanks 

 

[BIGAL]

To Fuccaro, you dont need this if the situation is always as indicated in sample dwg. The desired pline is boundary around text and no other plines etc within the shape.

(princ "select polyline")
  (setq	pl     (entget (car (entsel)))

If you use bpoly using the text insert point, then pl is (entlast) get co-ords etc run code then delete the dummy pl.

 

Just a suggestion.

 

Why not use.

(setq pl  (entget (car (entsel "\nPlease pick pline ")))

 

[fuccaro]

Engineer_Yasser: I am happy to help! As Bigal pointed out, there are some limitations. You know, when I write programs I try something, then I get a better idea and change the program here and there... Reading the program again I would say that a (setq ss nil) is missing at the end of the program, for better memory management . I also wouldn't create vmin, since the value is only used once - I would put the expression (apply 'min txt1) on the next line, where vmin is used. Variables could be localized, the (princ...) line could be deleted - I only used it for debugging.

But the most important limitation that comes to my mind is about selection: regardless if the initial polyline contains arcs or only lines, the program searches for texts inside another polyline that passes through the same vertices, but formed only by straight segments. In some cases, it might "forget" to select some texts. To explain better: see the following image. If the initial polyline is the blue one, the search area is the one in yellow. You can see that the text  201.3 is omitted. A quick fix: using CP instead of WP in the ssget line might improve the situation a bit. If all polyline segments are sure to have a matching text, the program could count the selected texts and warn the user if it doesn't match the number of vertices. That would be useful also if there are some stranger texts in the yellow area, outside the blue polyline.

 So Bigal and others: the program can be improved!

 

[marko_ribar]

@fuccaro

You can use point list by applying this sub to initial entity, just remember to put little bigger acc dividation factor...

 

  ;; Entity to Point List  -  M.R.
  ;; Returns a list of points describing or approximating the supplied entity, else nil if the entity is not supported.
  ;; ent - [ent] Entity name to be described by point list (POINT/LINE/ARC/CIRCLE/LWPOLYLINE/POLYLINE/ELLIPSE/SPLINE/HELIX)
  ;; acc - [num] Positive number determining the point density for non-linear objects

  (defun MR:ent->pts ( ent acc / der di1 di2 enx inc lst par fds fdm )

      (vl-load-com)

      (setq enx (entget ent))
      (cond
          (   (= "POINT" (cdr (assoc 0 enx)))
              (list (cdr (assoc 10 enx)))
          )
          (   (= "LINE" (cdr (assoc 0 enx)))
              (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx)))
          )
          (   (wcmatch (cdr (assoc 0 enx)) "ARC,CIRCLE")
              (setq di1 0.0
                    di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
                    inc (/ di2 acc)
                    di2 (- di2 1e-8)
              )
              (while (< di1 di2)
                  (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                        di1 (+ di1 inc)
                  )
              )
              (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))
          )
          (   (and (wcmatch (cdr (assoc 0 enx)) "*POLYLINE") (zerop (logand 80 (cdr (assoc 70 enx)))))
              (setq par 0)
              (repeat (fix (+ 1.0 1e-8 (vlax-curve-getendparam ent)))
                  (cond
                      (   (not (setq der (vlax-curve-getsecondderiv ent par))))
                      (   (equal der '(0.0 0.0 0.0) 1e-8)
                          (if (/= par (vlax-curve-getendparam ent))
                              (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
                          )
                      )
                      (   (not (equal der '(0.0 0.0 0.0) 1e-8))
                          (if (/= par (vlax-curve-getendparam ent))
                              (progn
                                  (setq di1 (vlax-curve-getdistatparam ent par)
                                        di2 (vlax-curve-getdistatparam ent (1+ par))
                                  )
                                  (setq inc (/ (- di2 di1) acc)
                                        di2 (- di2 1e-8)
                                  )
                                  (while (< di1 di2)
                                      (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                                            di1 (+ di1 inc)
                                      )
                                  )
                              )
                          )
                      )
                  )
                  (setq par (1+ par))
              )
              (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))
          )
          (   (wcmatch (cdr (assoc 0 enx)) "SPLINE,ELLIPSE,HELIX")
              (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                    di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                    inc (/ (- di2 di1) acc)
                    di2 (- di2 1e-8)
              )
              (while (< di1 di2)
                  (setq fds (cons (distance '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1))) fds)
                        di1 (+ di1 (distance '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1))))
                  )
              )
              (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)))
              (setq fdm (apply (function max) fds))
              (while (< di1 di2)
                  (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                        di1 (+ di1 (* (/ (distance '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1))) fdm) inc))
                  )
              )
              (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))
          )
      )
  ); end (MR:ent->pts ent acc)

 

[BIGAL]

A idea make a list of the angle from pick text to all other outer text, (0.23 30.32)(1.57 45.23) sort the list so in angle order. Again can rearrange list so matches say the desired selected segment. Yes I know may fail on a shape like "U" and "L". Will have a play.

Edited November 8, 2023 by BIGAL

[Danielm103]

my python routine didn’t use the line

1, map key =  text.position , value = text.string

2, calculate the centroid of the positions

3, sort the positions by angle to the centroid

[fuccaro]

7 hours ago, BIGAL said:

A idea make a list of the angle from pick text to all other outer text, (0.23 30.32)(1.57 45.23) sort the list so in angle order.

That's exactly what my program does, and I have no problems with that part. The "difficult" part is to select the texts. In the simplest form, the program could ask the user to make the selection. A more complex program will search for the all the texts inside of a polyline selected by the user -that's what my program does. An even more complex program would ask just for the central text and it could find the surrounding polyline. I will see if I can get some time these days...

[Engineer_Yasser]

@fuccaro @BIGAL

 

(defun c:ListLenghts ( / lst d c cPoz h ss txt i el txt1 p1)
	
	(vl-cmdf "_.undo" "_begin")
	
	(setvar "CMDECHO" 0)
	
	(defun *error* ( msg )
        (vl-cmdf "_.undo" "_end")
		(setvar "CMDECHO" 1)
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

	(defun pac (e / l v d lst)
		(setq lst nil)
		(setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
		(while (< (setq d (+ d v)) l)
			(setq lst (cons (vlax-curve-getPointAtDist e d) lst))
		)
		)
	(princ)
		
	(setq c (car (entsel "\n Select Center Text ")))
	(setq cPoz (cdr (assoc 10 (entget c))))
	(setq h (cdr (assoc 40 (entget c))))

	(setq ss (ssget "_CP" (pac (car (entsel "\n Select Polyline Enclosing Center Text "))) (list (cons 0 "TEXT"))))
	(ssdel c ss)

	(setq txt nil)
	(repeat (setq i (sslength ss))
		(setq el (entget (ssname ss (setq i (1- i)))))
		(setq txt (cons (list (cdr (assoc 1 el)) (setq ang (- (/ pi 2.0) (angle cPoz (cdr (assoc 10 el)))))) txt))
	)

	(setq txt (vl-sort txt '(lambda(a b) (< (cadr a) (cadr b)))))
	(setq txt1 (mapcar 'abs (mapcar 'cadr txt)))
	(setq i (- (length txt) (length (member (apply 'min txt1) txt1))))
	(setq p1 (getpoint "\nPick List Insertion Point"))

	(repeat (length txt)
		(entmake (list '(0 . "TEXT") (cons 1 (car (nth i txt))) (cons 40 h) (cons 10 p1)))
		(setq i (if (< i (1- (length txt))) (1+ i) 0))
		(setq p1 (mapcar '+ p1 (list 0 (* h -1.5) 0)))
	)
	
	(vl-cmdf "_.undo" "_end")
)
(princ)

 

This is the final modified code that works perfectly  .. Thanks For help 

 

 

Edited November 9, 2023 by Engineer_Yasser

[fuccaro]

PP is my default name for testing. You should add an useful name.

Also as I mentioned before, you should put at least SS in the parameters list

(defun c:ListLenghts ( / ss)
.....
)