Align text to nearest line.

August 14, 2019

6 minutes ago, rog1n said:

sorry I had never noticed this option

You can also just post "Thanks for doing that"

August 14, 2019

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

August 14, 2019

Thank you! Work perfect.

August 14, 2019

5 minutes ago, rog1n said:

Thank you! Work perfect.

Glad you got it working.

August 15, 2019

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

August 15, 2019

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

August 15, 2019

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..

August 15, 2019

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))
  )
)

August 15, 2019

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 )

August 15, 2019

Glad it's sorted

January 7, 2020

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

April 4, 2020

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.

April 5, 2020

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

April 6, 2020

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.

April 6, 2020

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?

June 24, 2020

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??

January 21, 2021

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

January 22, 2021

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

you living legend!! Thank you this is class

Thanks!

February 10, 2021

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

February 10, 2021

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

Sign In

Align text to nearest line.

Recommended Posts

ronjonp

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

ronjonp

ronjonp

Posted Images

ronjonp

rog1n

ronjonp

rog1n

ronjonp

rog1n

ronjonp

rog1n

ronjonp

Ngai Chen Chong

zams23

Jonathan Handojo

zams23

Jonathan Handojo

Bahar bz

Carrot King

ronjonp

Lee-Dawgs

rkmcswain

Join the conversation

ronjonp

ronjonp

ronjonp

Tutorials

Forums

Activity