Align text to nearest line.

[ronjonp]

6 minutes ago, rog1n said:

 

sorry I had never noticed this option

You can also just post "Thanks for doing that" 

[ronjonp]

I've highlighted the changes needed to work with lwpolylines .. see if you can get it going!

[rog1n]

Thank you! Work perfect.

[ronjonp]

5 minutes ago, rog1n said:

Thank you! Work perfect.

Glad you got it working. 

[rog1n]

If you can help me again I would appreciate, I tested your code with polyline that have many vertices and the text is aligned with the last two vertices (maybe I wrong), so I tried edit by myself the code.

 

I thought then that I should take all the vertices and check which ones are closest to the text and it works sometimes, I believe the mistake is that I need to find the shortest distance of two vertices (middle point). my knowledge of lisp is basic, even worse when it comes to mapcar and lambda, if not asking too much could help me make lisp work as  the example below.

(defun c:foo (/ a b h l lines mp p p1 p2 p3 p4 pa s text distances pfirst psecond)
  ;; RJP » 2019-08-07
  (if (setq s (ssget ":L" '((0 . "Lwpolyline,Line,Text"))))
    (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (if (= "TEXT" (cdr (assoc 0 (entget x))))
	       (setq text (cons x text))
	       (setq lines (cons x lines))
	     )
	   )
	   (if lines
	     (foreach x	text
	       (setq p (cdr (assoc 11 (entget x))))
	       (setq l (car (vl-sort lines
				     '(lambda (a b)
					(< (distance p (vlax-curve-getclosestpointto a p))
					   (distance p (vlax-curve-getclosestpointto b p))
					)
				      )
			    )
		       )
	       )
	       (setq h (* 0.75 (cdr (assoc 40 (entget x)))))
	       (setq b (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) (entget l)))
	       
	       (setq distances (mapcar '(lambda ( x ) (distance (cdr x) p)) b))
	       (setq pfirst (vl-position (apply 'min distances) distances))
               (setq psecond (vl-position (apply 'min (vl-remove (nth pfirst distances) distances)) distances))
	       (setq p1 (cdr (nth pfirst b)))
	       (setq p2 (cdr (nth psecond b)))
	       ;(setq p1 (car (mapcar 'cdr b)))
	       ;(setq p2 (cadr (mapcar 'cdr b)))
	       (setq mp (polar p1 (setq a (angle p1 p2)) (/ (distance p1 p2) 2)))
	       (setq p3 (polar mp (setq pa (+ (/ pi 2) a)) h))
	       (setq p4 (polar mp (+ pi pa) h))
	       (if (< (distance p p4) (distance p p3))
		 (setq p3 p4)
	       )
	       (entmod (subst (cons 50  (LM:readable a)) (assoc 50 (entget x)) (entget x)))
	       (entmod (subst (cons 10 p3) (assoc 10 (entget x)) (entget x)))
	       (entmod (subst (cons 11 p3) (assoc 11 (entget x)) (entget x)))
	     )
	   )
    )
  )
  (princ)
)
                      
(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)                      

 

example.dwg

Edited August 15, 2019 by rog1n

[ronjonp]

It can be modified but really a quick fix for your sample drawing is to explode the polylines then run the code.

[rog1n]

19 minutes ago, ronjonp said:

It can be modified but really a quick fix for your sample drawing is to explode the polylines then run the code.

 

So I will need transform all polylines to lines, run the lisp and back to polylines?

Can you please check what I doing wrong in the code of the lisp, because only 3 text get wrong alignment..

[ronjonp]

Try this:

(defun c:foo (/ a h j l lines mp p p3 p4 pa r s text)
  ;; Get a list of midpoints and angles ( not for arced segments )
  (defun _mpa (e / l l2)
    (setq
      l	(mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) (entget e)))
    )
    (setq l2 (append (cdr l) (list (car l))))
    (mapcar '(lambda (r j) (list (mapcar '/ (mapcar '+ r j) '(2 2)) (angle r j))) l l2)
  )
  ;; RJP » 2019-08-15
  (if (setq s (ssget ":L" '((0 . "Lwpolyline,Line,Text"))))
    (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (if (= "TEXT" (cdr (assoc 0 (entget x))))
	       (setq text (cons x text))
	       (setq lines (cons (_mpa x) lines))
	     )
	   )
	   (if (setq lines (apply 'append lines))
	     (foreach x	text
	       (setq p (cdr (assoc 11 (entget x))))
	       (setq
		 l (car (vl-sort lines '(lambda (a b) (< (distance p (car a)) (distance p (car b))))))
	       )
	       (setq h (* 0.75 (cdr (assoc 40 (entget x)))))
	       (setq p3 (polar (setq mp (car l)) (setq pa (+ (/ pi 2) (setq a (cadr l)))) h))
	       (setq p4 (polar mp (+ pi pa) h))
	       (if (< (distance p p4) (distance p p3))
		 (setq p3 p4)
	       )
	       (entmod (subst (cons 50 (lm:readable a)) (assoc 50 (entget x)) (entget x)))
	       (entmod (subst (cons 10 p3) (assoc 10 (entget x)) (entget x)))
	       (entmod (subst (cons 11 p3) (assoc 11 (entget x)) (entget x)))
	       (grdraw p p3 3)
	     )
	   )
    )
  )
  (princ)
)

(defun lm:readable (a)
  ((lambda (a)
     (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
       (lm:readable (+ a pi))
       a
     )
   )
    (rem (+ a pi pi) (+ pi pi))
  )
)

 

[rog1n]

7 minutes ago, ronjonp said:

Try this:

(defun c:foo (/ a h j l lines mp p p3 p4 pa r s text)
  ;; Get a list of midpoints and angles ( not for arced segments )
  (defun _mpa (e / l l2)
    (setq
      l	(mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) (entget e)))
    )
    (setq l2 (append (cdr l) (list (car l))))
    (mapcar '(lambda (r j) (list (mapcar '/ (mapcar '+ r j) '(2 2)) (angle r j))) l l2)
  )
  ;; RJP » 2019-08-15
  (if (setq s (ssget ":L" '((0 . "Lwpolyline,Line,Text"))))
    (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (if (= "TEXT" (cdr (assoc 0 (entget x))))
	       (setq text (cons x text))
	       (setq lines (cons (_mpa x) lines))
	     )
	   )
	   (if (setq lines (apply 'append lines))
	     (foreach x	text
	       (setq p (cdr (assoc 11 (entget x))))
	       (setq
		 l (car (vl-sort lines '(lambda (a b) (< (distance p (car a)) (distance p (car b))))))
	       )
	       (setq h (* 0.75 (cdr (assoc 40 (entget x)))))
	       (setq p3 (polar (setq mp (car l)) (setq pa (+ (/ pi 2) (setq a (cadr l)))) h))
	       (setq p4 (polar mp (+ pi pa) h))
	       (if (< (distance p p4) (distance p p3))
		 (setq p3 p4)
	       )
	       (entmod (subst (cons 50 (lm:readable a)) (assoc 50 (entget x)) (entget x)))
	       (entmod (subst (cons 10 p3) (assoc 10 (entget x)) (entget x)))
	       (entmod (subst (cons 11 p3) (assoc 11 (entget x)) (entget x)))
	       (grdraw p p3 3)
	     )
	   )
    )
  )
  (princ)
)

(defun lm:readable (a)
  ((lambda (a)
     (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
       (lm:readable (+ a pi))
       a
     )
   )
    (rem (+ a pi pi) (+ pi pi))
  )
)

 

 

 

Wow, work like a charm! I will study your code to try understand what happens.

 

And thank you for you help! (this time I didn't forget to thank you )

[ronjonp]

Glad it's sorted 

[Ngai Chen Chong]

Hi all, thank you so much for sharing the lisps. They help me a lot in my daily task.

 

However, can anyone help me to modify the lisp so that the texts will get back to their insertion points (place before applying both the wonderful lisps contributed by Ronjonp and Alan Thompson) in stead of line midpoint. I did went through some other discussions about moving blocks back to their original insertion points, but i just can't figure out a way to make texts possible. Attached is the example drawing. Thank you.

Insertion.dwg

[zams23]

On 6/14/2017 at 9:39 PM, ronjonp said:

Here's a version that will work with polylines too:

 

(defun c:foo (/ _aap l lines p p2 ss text)
 ;; RJP - 6.14.2017
 (defun _aap (ename pt / param)
   (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
     (setq param (vlax-curve-getparamatpoint ename pt))
)
     (angle '(0 0) (vlax-curve-getfirstderiv ename param))
   )
 )
 (if (setq ss (ssget '((0 . "*polyline,Line,Text"))))
   (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (if (= "TEXT" (cdr (assoc 0 (entget x))))
       (setq text (cons x text))
       (setq lines (cons x lines))
     )
   )
   (if lines
     (foreach x	text
       (setq p (cdr (assoc 10 (entget x))))
       (setq
	 l (mapcar
	     '(lambda (x)
		(list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2))
	      )
	     lines
	   )
       )
       (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
       (entmod (subst (cons 50 (caddr l)) (assoc 50 (entget x)) (entget x)))
     )
   )
   )
 )
 (princ)
)

 

 

but if i am make the polyline like this, the text become reversed. and then the text didnt move to line or polylines.

i want to like this, the multiple text will be move to polylines and the rotate follow the alignment polylines.

[Jonathan Handojo]

On 4/4/2020 at 11:53 AM, zams23 said:

but if i am make the polyline like this, the text become reversed. and then the text didnt move to line or polylines.

i want to like this, the multiple text will be move to polylines and the rotate follow the alignment polylines.

 

Initially this post was meant to only rotate the text to the nearest polyline, so this forum is out of your request.

 

For your case, I modified two lines from ronjonp's code. it should give you the desired result.

 

(defun c:foo (/ _aap l lines p p2 ss text)
 ;; RJP - 6.14.2017
 (defun _aap (ename pt / param)
   (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
     (setq param (vlax-curve-getparamatpoint ename pt))
)
     (angle '(0 0) (vlax-curve-getfirstderiv ename param))
   )
 )
 (if (setq ss (ssget '((0 . "*polyline,Line,Text"))))
   (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (if (= "TEXT" (cdr (assoc 0 (entget x))))
       (setq text (cons x text))
       (setq lines (cons x lines))
     )
   )
   (if lines
     (foreach x	text
       (setq p (cdr (assoc 10 (entget x))))
       (setq
	 l (mapcar
	     '(lambda (x)
		(list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2))
	      )
	     lines
	   )
       )
       (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
       (entmod (subst (cons 50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x)) (caddr l))) (assoc 50 (entget x)) (entget x))) ; <--- Modified by Jonathan Handojo
       (entmod (subst (cons 10 (car l)) (assoc 10 (entget x)) (entget x))) ; <--- Line added by Jonathan Handojo
     )
   )
   )
 )
 (princ)
)

 

Edited April 5, 2020 by Jonathan Handojo

[zams23]

21 hours ago, Jonathan Handojo said:

 

Initially this post was meant to only rotate the text to the nearest polyline, so this forum is out of your request.

 

For your case, I modified two lines from ronjonp's code. it should give you the desired result.

 

(defun c:foo (/ _aap l lines p p2 ss text)
 ;; RJP - 6.14.2017
 (defun _aap (ename pt / param)
   (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
     (setq param (vlax-curve-getparamatpoint ename pt))
)
     (angle '(0 0) (vlax-curve-getfirstderiv ename param))
   )
 )
 (if (setq ss (ssget '((0 . "*polyline,Line,Text"))))
   (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (if (= "TEXT" (cdr (assoc 0 (entget x))))
       (setq text (cons x text))
       (setq lines (cons x lines))
     )
   )
   (if lines
     (foreach x	text
       (setq p (cdr (assoc 10 (entget x))))
       (setq
	 l (mapcar
	     '(lambda (x)
		(list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2))
	      )
	     lines
	   )
       )
       (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
       (entmod (subst (cons 50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x)) (caddr l))) (assoc 50 (entget x)) (entget x))) ; <--- Modified by Jonathan Handojo
       (entmod (subst (cons 10 (car l)) (assoc 10 (entget x)) (entget x))) ; <--- Line added by Jonathan Handojo
     )
   )
   )
 )
 (princ)
)

 

thank you very much for the solution, I hope that someone can bring the text closer to the polylines. not just rotate according to the polylines.

[Jonathan Handojo]

31 minutes ago, zams23 said:

thank you very much for the solution, I hope that someone can bring the text closer to the polylines. not just rotate according to the polylines.

Umm, it did. Have you tested it?

[Bahar bz]

Hello

Dear all

I have the same problem. I have a set of data from sewergems the plan dusplayed is proper but when exported as dxf the texts are missaligned. Im seeking for a lisp code to align the texts at the center of the polyline. Can amybody give me hint??

 

[Carrot King]

On 14/06/2017 at 14:39, ronjonp said:

(defun c:foo (/ _aap l lines p p2 ss text) ;; RJP - 6.14.2017 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,Text")))) (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (= "TEXT" (cdr (assoc 0 (entget x)))) (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) (entmod (subst (cons 50 (caddr l)) (assoc 50 (entget x)) (entget x))) ) ) ) ) (princ) )

 

On 14/06/2017 at 14:39, ronjonp said:

Here's a version that will work with polylines too:

 

(defun c:foo (/ _aap l lines p p2 ss text)
 ;; RJP - 6.14.2017
 (defun _aap (ename pt / param)
   (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
     (setq param (vlax-curve-getparamatpoint ename pt))
)
     (angle '(0 0) (vlax-curve-getfirstderiv ename param))
   )
 )
 (if (setq ss (ssget '((0 . "*polyline,Line,Text"))))
   (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (if (= "TEXT" (cdr (assoc 0 (entget x))))
       (setq text (cons x text))
       (setq lines (cons x lines))
     )
   )
   (if lines
     (foreach x	text
       (setq p (cdr (assoc 10 (entget x))))
       (setq
	 l (mapcar
	     '(lambda (x)
		(list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2))
	      )
	     lines
	   )
       )
       (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
       (entmod (subst (cons 50 (caddr l)) (assoc 50 (entget x)) (entget x)))
     )
   )
   )
 )
 (princ)
)

 

 

you living legend!! Thank you this is class 

[ronjonp]

On 1/21/2021 at 6:44 AM, Carrot King said:

 

you living legend!! Thank you this is class 

Thanks! 

[Lee-Dawgs]

Hi, 
I have tried pasting this code multiple times into the command bar and nothing happens.
Am I missing something?

[rkmcswain]

9 hours ago, Lee-Dawgs said:

Hi, 
I have tried pasting this code multiple times into the command bar and nothing happens.
Am I missing something?

 

What code exactly? Did it begin with

(defun c:foo (/ _aap l lines p p2 ss text)

 

??

 

If so, then what you are doing is loading the code (and function name "Foo") into the memory for that drawing file.

At this point, you should be able to type in the command FOO to execute the code