Placing text on a polyline / LISP modification

[Browning_Zed]

Hi All,
I'm trying to change LISP to fit my needs, but I ran into one problem. The routine does the following: using the function entsel, select a polyline and get its properties (lengths and angles of segments, as well as a layer), after which the program asks for text input and places the mtext in the middle of each segment of the polyline. I need: after placing mtext on the polyline, the command must not end; instead, a loop is started, within which it will be possible to continue selecting polylines (located only on the layer of the first picked polyline) using the entsel function, and the previously entered text should be placed on each next selected polyline. Exit the loop by press the key Esc or Enter / Space. How to do it?

(defun c:TextPline ( / obj vert lay du tt n s0 i txt p1 p2 s ang pt )
	(while
		(or
			(not (setq obj  (car (entsel "\nPick LwPolyline >"))))
			(if obj
				(/= (cdr (assoc 0 (entget obj))) "LWPOLYLINE")
			)
		)
		(prompt "\nMissed or picked wrong entity type. ")
	)
	(setq 
		vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
		lay  (vla-get-layer (vlax-ename->vla-object obj))
		du   (getstring t "Text above the line: ")
		tt   (getstring t "Text under the line: ")
		n    (1- (length vert))
		s0   0
		i    0   
	)
	(if (= tt "")
		(setq txt (strcat du "\n "))
		(setq txt (strcat du "\n" tt))
	)
	(repeat n
		(setq 
			p1  (nth i vert)
			p2  (nth (setq i (1+ i)) vert)
			s   (/ (distance p1 p2) 2)
			s0  (+ s0 s)
			ang (angle p1 p2)
			pt  (vlax-curve-getPointAtDist obj s0)
			s0  (+ s0 s)
		)
		(if (> (* pi 1.5) ang (* pi 0.5))
			(setq ang (+ ang pi))
		)
		(entmakex 
			(list 
				(cons 0 "MTEXT")
				(cons 100 "AcDbEntity")
				(cons 100 "AcDbMText")
				(cons 1 txt)
				(cons 7 "Standard")
				(cons 8 lay)
				(cons 10 pt)
				(cons 40 2)
				(cons 50 ang)
				(cons 62 256)
				(cons 71 5)
				(cons 72 5)
				(cons 44 1.3)
            )
		)
	)
)
 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;***|;

[hak_vz]

Try this

(defun c:TextPline ( / obj vert lay du tt n s0 i txt p1 p2 s ang pt )
	(while (and (setq obj  (car (entsel "\nPick LwPolyline >")))(= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"))
		(setq 
			vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
			lay  (vla-get-layer (vlax-ename->vla-object obj))
			du   (getstring t "Text above the line: ")
			tt   (getstring t "Text under the line: ")
			n    (1- (length vert))
			s0   0
			i    0   
		)
		(if (= tt "")
			(setq txt (strcat du "\n "))
			(setq txt (strcat du "\n" tt))
		)
		(repeat n
			(setq 
				p1  (nth i vert)
				p2  (nth (setq i (1+ i)) vert)
				s   (/ (distance p1 p2) 2)
				s0  (+ s0 s)
				ang (angle p1 p2)
				pt  (vlax-curve-getPointAtDist obj s0)
				s0  (+ s0 s)
			)
			(if (> (* pi 1.5) ang (* pi 0.5))
				(setq ang (+ ang pi))
			)
			(entmakex 
				(list 
					(cons 0 "MTEXT")
					(cons 100 "AcDbEntity")
					(cons 100 "AcDbMText")
					(cons 1 txt)
					(cons 7 "Standard")
					(cons 8 lay)
					(cons 10 pt)
					(cons 40 2)
					(cons 50 ang)
					(cons 62 256)
					(cons 71 5)
					(cons 72 5)
					(cons 44 1.3)
				)
			)
		)
	)
)

[Browning_Zed]

Ok this works, but I need a little different. In your version of the code, after picking each next polyline, the program again asks for text input. I need the text to remain the same (which was specified when the first polyline was selected). That is, when select each next polyline, there should be no new text input, the text line must be from the first input. Also, if possible, each next polyline can be selected only if it placed on the same layer as the first selected polyline, polylines on other layers should be ignored.

[hak_vz · Accepted solution]

(defun c:TextPline ( / obj vert lay du tt n s0 i txt p1 p2 s ang pt )
	(setq 
		du   (getstring t "Text above the line: ")
		tt   (getstring t "Text under the line: ")
		lay  (cdr (assoc 8 (entget (car(entsel "\nSelect polyine to lock active layer >")
	)
	
	(while (and (setq obj  (car (entsel "\nPick LwPolyline >")))(= (cdr (assoc 0 (entget obj))) "LWPOLYLINE") (= lay (cdr (assoc 8 (entget obj)))))
		(setq 
			vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
			lay  (vla-get-layer (vlax-ename->vla-object obj))
			n    (1- (length vert))
			s0   0
			i    0   
		)
		(if (= tt "")
			(setq txt (strcat du "\n "))
			(setq txt (strcat du "\n" tt))
		)
		(repeat n
			(setq 
				p1  (nth i vert)
				p2  (nth (setq i (1+ i)) vert)
				s   (/ (distance p1 p2) 2)
				s0  (+ s0 s)
				ang (angle p1 p2)
				pt  (vlax-curve-getPointAtDist obj s0)
				s0  (+ s0 s)
			)
			(if (> (* pi 1.5) ang (* pi 0.5))
				(setq ang (+ ang pi))
			)
			(entmakex 
				(list 
					(cons 0 "MTEXT")
					(cons 100 "AcDbEntity")
					(cons 100 "AcDbMText")
					(cons 1 txt)
					(cons 7 "Standard")
					(cons 8 lay)
					(cons 10 pt)
					(cons 40 2)
					(cons 50 ang)
					(cons 62 256)
					(cons 71 5)
					(cons 72 5)
					(cons 44 1.3)
				)
			)
		)
	)
	(princ)
)

[Browning_Zed]

Thanks for the help, this works.

[Browning_Zed]

Hi again.
I am trying to further modify the code and add a condition. Now when I select the polyline the code doesn't work. What could be the reason?

(defun c:TextPline ( / obj vert lay du tt n s0 i txt p1 p2 s ang pt )
	(setq 
		du   (getstring t "Text above the line: ")
		tt   (getstring t "Text under the line: ")
	)
	(while
		(progn
			(setvar 'errno 0)
			(and (setq obj  (car (entsel "\nPick LwPolyline >")))(= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"))
			(cond
				(   (= 7 (getvar 'errno))
					(princ "\nMissed, try again.") ;; Stay in loop
				)
				(   (null ent)
					nil ;; Exit loop
				)
				(	
					(setq 
						vert (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)))
						lay  (vla-get-layer (vlax-ename->vla-object obj))
						n    (1- (length vert))
						s0   0
						i    0   
					)
					(if (= tt "")
						(setq txt (strcat du "\n "))
						(setq txt (strcat du "\n" tt))
					)
					(repeat n
						(setq 
							p1  (nth i vert)
							p2  (nth (setq i (1+ i)) vert)
							s   (/ (distance p1 p2) 2)
							s0  (+ s0 s)
							ang (angle p1 p2)
							pt  (vlax-curve-getPointAtDist obj s0)
							s0  (+ s0 s)
						)
						(if (> (* pi 1.5) ang (* pi 0.5))
							(setq ang (+ ang pi))
						)
						(entmakex 
							(list 
								(cons 0 "MTEXT")
								(cons 100 "AcDbEntity")
								(cons 100 "AcDbMText")
								(cons 1 txt)
								(cons 7 "Standard")
								(cons 8 lay)
								(cons 10 pt)
								(cons 40 2)
								(cons 50 ang)
								(cons 62 256)
								(cons 71 5)
								(cons 72 5)
								(cons 44 1.3)
							)
						)
					)
               )
           )
       )
   )
   (princ)
)

[Kent1Cooper]

---

@Browning_Zed wrote:

....
I am trying to further modify the code and add a condition. Now when I select the polyline the code doesn't work. What could be the reason?

---

Here is how I have done that kind of thing.  It handles the case that something was selected, but not the right kind of thing, as a separate condition.  The 'done' variable needs to be added to the localized-variable list.

....
  (while (not done)
    (setvar 'errno 0)
    (setq obj (car (entsel "\nPick LwPolyline <exit>: ")))
    (cond
      ((= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"); picked LWPolyline
        (setq 
          vert ....
          ....
        )
        (repeat .....
          (entmakex 
            ....
          )
        ); repeat
      ); end picked-a-Polyline condition
      ((= 0 (getvar 'errno))
        (princ "\nNot a LWPolyline, try again.")
      ); end picked-wrong-kind-of-thing condition
      ((= 7 (getvar 'errno))
        (princ "\nMissed, try again.")
      ); end missed-pick condition
      ((setq done T)); Enter/space at Select-object prompt [errno = 52]; End loop
    ); end cond
  ); end while
....

[Browning_Zed]

In this case, if I click past the polyline, the loop is exited. How to make sure that the loop does not interrupt, and exit from it was possible by pressing Esc?

[Kent1Cooper · Accepted solution]

---

@Browning_Zed wrote:

In this case, if I click past the polyline, the loop is exited. How to make sure that the loop does not interrupt, and exit from it was possible by pressing Esc?

---

EDIT:  If you mean if you pick off the Polyline [in empty space], it's probably from there being no 'obj' to (entget).  [I left out an element from what I pulled from another routine.]  Try changing this:

      ((= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"); picked LWPolyline

to this:

      ((and obj (= (cdr (assoc 0 (entget obj))) "LWPOLYLINE")); picked LWPolyline

It could probably also be done by moving the missed-pick condition to before the it's-a-Polyline condition:

....
  (while (not done)
    (setvar 'errno 0)
    (setq obj (car (entsel "\nPick LwPolyline <exit>: ")))
    (cond
      ((= 7 (getvar 'errno))
        (princ "\nMissed, try again.")
      ); end missed-pick condition
      ((= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"); picked LWPolyline
        (setq 
          vert ....
          ....
        )
        (repeat .....
          (entmakex 
            ....
          )
        ); repeat
      ); end picked-a-Polyline condition
      ((= 0 (getvar 'errno))
        (princ "\nNot a LWPolyline, try again.")
      ); end picked-wrong-kind-of-thing condition
      ((setq done T)); Enter/space at Select-object prompt [errno = 52]; End loop
    ); end cond
  ); end while
....

If one of those doesn't do it, describe in more detail what you mean by "click past the polyline."  If you pick in empty space, it should meet the errno=7 condition and go back to ask for selection again.

In any case, you should be able to exit from any routine by pressing Esc, but this approach also lets Enter/space end it, accepting the <exit> default in the selection prompt.

[Browning_Zed]

Yes, I meant pick in empty space. I used your latest code and it works great. Thank you very much!

[btyrrellSREGN]

Using this code is it possible to make it so it drops the text by a specified distance. Similar to how array path works.

[smallƑish]

 Can anyone help me to write this as complete code? as my AutoCAD showing error.

[mfeamster]

Is there a way to get this to only annotate once at the middle of the polyline? Not just on each segment but at the mid point of the polyline as a whole.

[Kent1Cooper]

---

@mfeamster wrote:

Is there a way to get this to only annotate once at the middle of the polyline? Not just on each segment but at the mid point of the polyline as a whole.

---

For a routine that has the option of the overall midpoint or the midpoints of each segment, when the path object is a Polyline, see the MMP command defined in MarkMidPoints.lsp, >here<.  It could be modified to add Text as a marking option, or its overall-midpoint option could be incorporated into routines here.

One meaningful difference is the way it finds the midpoints of segments, though perhaps not an issue for your request since the overall midpoint is not likely to be at the midpoint of a segment.  Since routines here use half the [straight-line] distance between vertices to decide how far along the segment is the midpoint, they are written with line segments only in mind, and they will be thrown off by arc segments, and more so the greater the bulge factor.  MMP uses a different way that will actually get the midpoint of either kind of segment.  And it gets the rotation correctly, based on the local direction the Polyline is running at that point, not the angle between adjacent vertices.