Align text to nearest line.

September 9, 2021

On 05/04/2020 at 07:29, 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)
)

Hi Jonathan, these addons to ronjonp's code you made work great. Thanks to both of you. I have no experience with LISP coding, so the question maybe out of the scope of this thread's topic, but many times when i have run your LISP, it returns a "bad DXF group: (50)" error.
IF i only select one text object and one line, it works great. But if i select multiple text objects and multiple lines, the code only works on some or none, and returns the error.
Is there a simple edit i can make to the code to avoid this?
Many thanks in advance.

September 9, 2021

10 hours ago, Mitch Leach said:

Hi Jonathan, these addons to ronjonp's code you made work great. Thanks to both of you. I have no experience with LISP coding, so the question maybe out of the scope of this thread's topic, but many times when i have run your LISP, it returns a "bad DXF group: (50)" error.
IF i only select one text object and one line, it works great. But if i select multiple text objects and multiple lines, the code only works on some or none, and returns the error.
Is there a simple edit i can make to the code to avoid this?
Many thanks in advance.

Can you post a sample drawing?

September 10, 2021

Hi Jonathan, here is a simplified file of what i am working with. My intention is to select all the text, all the lines, use FOO to get all the text objects running parallel to their nearest line, doesn't matter which really. With ronjon's first run at the problem, the lisp worked but some of the text appeared "upside-down". For drafting purposes that is undesirable. If 0º orientation is north, 180º is south, the text orientation would have to be between 0º and 179º. 180 and above it needs to be flipped around, so that it can always be read normally or from the right. I have made and attached a quick diagram to help explain.

test.dwg

September 11, 2021

Up side down text, google Lee-mac readable text.

September 13, 2021

Hi Bigal, yeah, i have looked at lot of the Lee-Mac programs, and i couldnt find any that suited or were as simple as the LISPs previously posted here... the fact that with Ronjon's code, all the lines and text can be selected in one go is very efficient.
I think Jonathan's improvements are close to the mark, just was hoping to iron out that "bad DXF error"...
Thanks in advance to anyone that can help!

September 13, 2021

On 9/13/2021 at 1:13 AM, Mitch Leach said:

Hi Bigal, yeah, i have looked at lot of the Lee-Mac programs, and i couldnt find any that suited or were as simple as the LISPs previously posted here... the fact that with Ronjon's code, all the lines and text can be selected in one go is very efficient.
I think Jonathan's improvements are close to the mark, just was hoping to iron out that "bad DXF error"...
Thanks in advance to anyone that can help!

Try this .. it was bonking out because the _aap function was returning nil.

(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))))))
	       ;; Check that we have an angle assigned
	       (if (caddr l)
		 (progn	(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 September 14, 2021 by ronjonp

September 13, 2021

Ronjop, you are a legend. Worked a treat. Has stopped giving the error message and works selecting multiple lines and text. Some text doesnt rotate on the first go, and seems to work best in small batches, but hey, I'll take that any day of the week and twice on Sundays if it means i dont have to TORIENT each text individually!
Thanks again.

September 13, 2021

51 minutes ago, Mitch Leach said:

Ronjop, you are a legend. Worked a treat. Has stopped giving the error message and works selecting multiple lines and text. Some text doesnt rotate on the first go, and seems to work best in small batches, but hey, I'll take that any day of the week and twice on Sundays if it means i dont have to TORIENT each text individually!
Thanks again.

Glad to help out!

September 14, 2021

10 hours ago, ronjonp said:

Try this .. it was bonking out because the _aap function was returning nil for some of the texts.


(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))))))
	       ;; Check that we have an angle assigned
	       (if (caddr l)
		 (progn	(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)
)

very cool! does it only work with single line text though? would be great if it could do multiline text also

September 14, 2021

masterfal, yes, it only works on text and not MTEXT... I'll leave it up to the LISP gurus to let you know whether its a simple fix or not to add code for MTEXT....

September 14, 2021

2 hours ago, Mitch Leach said:

masterfal, yes, it only works on text and not MTEXT... I'll leave it up to the LISP gurus to let you know whether its a simple fix or not to add code for MTEXT....

For mtext:

;; Change this
(setq ss (ssget '((0 . "*polyline,Line,Text"))))
;; to this
(setq ss (ssget '((0 . "*polyline,Line,*Text"))))
;; and this
(if (= "TEXT" (cdr (assoc 0 (entget x))))
;; to this
(if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT")

September 15, 2021

Thanks for that Ronjonp. A quick question regarding your changes; will the additions now only work for MTEXT, or has it made the code more versatile, now working with any type of text, be it multi or not?
If it is only for MTEXT, ill create a new separate LISP file, and have one for each type of text
Thanks again.

Edited September 15, 2021 by Mitch Leach

September 16, 2021

The use of wildcards is as old fashioned as the 1st pc's the *

So *Text means just that anything ie 1-0 or a-z,A-z or combinations in front of the Text.

Using *LINE will find Line, Polyline and LWPOLYLINE.

Likewise if wanted layers 1a, 2a etc then would use #a or to force a number #* for 1abcdefg

Edited September 16, 2021 by BIGAL

September 16, 2021

On 9/15/2021 at 9:05 AM, Mitch Leach said:

Thanks for that Ronjonp. A quick question regarding your changes; will the additions now only work for MTEXT, or has it made the code more versatile, now working with any type of text, be it multi or not?
If it is only for MTEXT, ill create a new separate LISP file, and have one for each type of text
Thanks again.

To supplement BIGAL's post, take a look HERE for wcmatch reference.

October 6, 2021

Is it possible define a set distance between the *text and the *lines in the lsp file?

October 6, 2021

3 hours ago, bobbykimchi said:

Is it possible define a set distance between the *text and the *lines in the lsp file?

Give this version a try:

(defun c:foo (/ _aap a d l lines p p2 ss text x)
  ;; RJP » 2021-10-06
  (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
      (or (setq d (getdist "\nEnter offset distance:<0> ")) (setq d 0))
      (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT")
	  (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))))))
	  ;; Check that we have an angle assigned
	  (if (caddr l)
	    (progn (entmod (subst (cons	50
					((lambda (x)
					   (setq a (if (<= (* 0.5 pi) x (* 1.5 pi))
						     (+ x pi)
						     x
						   )
					   )
					 )
					  (caddr l)
					)
				  )
				  (assoc 50 (entget x))
				  (entget x)
			   )
		   )
	    )
	  )				; <--- Modified by Jonathan Handojo
	  ;; RJP added offset
	  (entmod (subst (cons 10 (polar (car l) (+ (/ pi 2) a) d)) (assoc 10 (entget x)) (entget x))
	  )				; <--- Line added by Jonathan Handojo
	)
      )
    )
  )
  (princ)
)

November 1, 2021

Excellent this AutiLISP, very good but it has a small problem that to be perfect it is necessary that the text does not change the side of the line.
Imagine a polygon and the text is on the outside, it must always remain outside. If it is internal it must remain internal.
The text must be aligned and moved to the next line and must not be moved to the other side.
As for the offset, it can be a percentage of the text height.
Do not understand it as a criticism but rather a constructive comment.

ok.

November 1, 2021

16 hours ago, FELIXJM said:

Excellent this AutiLISP, very good but it has a small problem that to be perfect it is necessary that the text does not change the side of the line.
Imagine a polygon and the text is on the outside, it must always remain outside. If it is internal it must remain internal.
The text must be aligned and moved to the next line and must not be moved to the other side.
As for the offset, it can be a percentage of the text height.
Do not understand it as a criticism but rather a constructive comment.

ok.

I guess that in that case, you don't need offset at all...

Quickly written, and untested...

(defun c:maketextreadable ( / _aap l lines p2 ss text dxf50 xx minp maxp mp pp d )

  (vl-load-com)

  ;; RJP » 2021-10-06
  ;; MR » 2021-01-11

  (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 (= 8 (logand 8 (getvar 'undoctl)))
    (vl-cmdf "_.UNDO" "_E")
  )
  (vl-cmdf "_.UNDO" "_M")
  (if (setq ss (ssget '((0 . "*polyline,Line,*Text"))))
    (progn
      (or (setq d (getdist "\nEnter offset distance <0> : ")) (setq d 0))
      (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (if (and (wcmatch (cdr (assoc 0 (setq xx (entget x)))) "*TEXT") (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 xx))))))))
          (setq text (cons x text))
          (if (not (wcmatch (cdr (assoc 0 xx)) "*TEXT"))
            (setq lines (cons x lines))
          )
        )
      )
      (if lines
        (foreach x text
          (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp)
          (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp)))
          (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp))
          (setq
            l (mapcar
                '(lambda (x)
                   (list (setq p2 (vlax-curve-getclosestpointto x mp)) (distance mp p2) (_aap x p2))
                 )
                lines
              )
          )
          (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
          ;; Check that we have an angle assigned
          (if (caddr l)
            (progn
              (setq dxf50
                ((lambda (x)
                   (if (<= (* 0.5 pi) x (* 1.5 pi))
                     (+ x pi)
                     x
                   )
                 )
                 (caddr l)
                )
              )
              (entupd (cdr (assoc -1 (entmod (subst (cons 50 dxf50) (assoc 50 (setq xx (entget x))) xx)))))
              (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp)
              (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp)))
              (setq pp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp))
              (vla-move (vlax-ename->vla-object x) (vlax-3d-point pp) (vlax-3d-point mp))
              (vla-move (vlax-ename->vla-object x) (vlax-3d-point mp) (vlax-3d-point (car l)))
              (vla-move (vlax-ename->vla-object x) (vlax-3d-point (car l)) (vlax-3d-point (polar (car l) (angle (car l) mp) d)))
            )
          )
        )
      )
    )
  )
  (vl-cmdf "_.UNDO" "_E")
  (princ)
)

Edited November 1, 2021 by marko_ribar

November 1, 2021

error: malformed list on input

I'm trying to figure out where the parenthesis is missing or left.

November 1, 2021

At the end.

              (vla-move (vlax-ename->vla-object x) (vlax-3d-point mp) (vlax-3d-point pp))
            )
          )
        )
      )
    )
  )
  (princ)
)

Sign In

Align text to nearest line.

Recommended Posts

Mitch Leach

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

ronjonp

ronjonp

Posted Images

Jonathan Handojo

Mitch Leach

BIGAL

Mitch Leach

ronjonp

Mitch Leach

ronjonp

masterfal

Mitch Leach

ronjonp

Mitch Leach

BIGAL

ronjonp

bobbykimchi

ronjonp

FELIXJM

marko_ribar

FELIXJM

mhupp

Join the conversation

ronjonp

ronjonp

ronjonp

Tutorials

Forums

Activity