Adding text to polyline LISP

[_anonandon]

Does anyone know of a lisp to do something like this??

Label multiple 2d or lwpolylines to with aligned readable text at intervals.

A path array (exploded) works but I'd like to label ALL polylines at once.

cheers

[Kent1Cooper]

Would a linetype with text inclusions work?  They could be raised above the path -- they don't necessarily need to be centered on it as in sample AutoCAD linetypes.  It could include the arrows as well as the text, if their having a more regular relationship is usable for you.  But they would need to be the same color.

For a difference in color between path and text, a MULTILINE Style could be defined, using a linetype that is only the text inclusions.  It would need to at least have points, but they might be able to be buried in the text, or in the path beneath it.

[_anonandon]

unfortunately not, need this to work with different linetypes

[_anonandon]

i've also used/butchered! this:

(defun c:txx ( / add local variables here)
  (and
	(if (setq description (car (entsel "\nPick source text: "))) ;; from tutorial
	(setq description (cdr (assoc 1 (entget description))))) ;; from tutorial
    (while(setq pick (entsel "\nSelect point on line: ")) ;; careful where you put this!
    (setq style (getvar "textstyle")) ;; or whatever you want, if it exists
    (setq txtht (cdr (assoc 40 (tblsearch "style" style))))
	;(setq layer "current") ;; this half works.............
	(setq offset (* 0.90 txtht)) ;; VERTICAL OFFSET OF TEXT FROM LINE or whatever factor suits you, depending on justification
	(setq object (vlax-ename->vla-object (car pick))
               p (vlax-curve-getclosestpointto object (cadr pick))
               param (vlax-curve-getparamatpoint object p)
               ang (vlax-curve-getfirstderiv object param)
               ang (angle '(0 0 0) ang)
               perpang (if (<= (/ pi 2) ang (* 1.5 pi))(- ang (/ pi 2))(+ ang (/ pi 2)))
               txtang (if (<= (/ pi 2) ang (* 1.5 pi))(- ang pi) ang) ;; text angle in radians
               tip (polar p perpang offset)  ;; text insertion point for Bot Left just.
	)
    (entmake
      (list
       '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
       '(10 0.0 0.0 0.0) (cons 40 txtht) (cons 1 description) (cons 50 txtang); (cons 8 layer)
       '(41 . 1.0) '(51 . 0.0) (cons 7 style) '(71 . 0) '(72 . 0) (cons 10 tip) 
       '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)
      )
     ))
	)
  (princ)
)

[hosneyalaa]

Can you attached example drawing 

[Kent1Cooper]

How about one that you can use as a copy in-place of your path object, with a linetype that just has the text inclusions?  This definition:

A,0,-8,["text",STANDARD,x=-1.125,y=.5,s=1,u=0]

does this:

The dots lie along the path, so they get buried when used as follows:

If I have the green path [Polyline] here, Copy that in-place, and change the linetype of one of them, I get this:

So they can be on different Layers, or on the same Layer in different colors, even different linetype scales, or whatever you like.  [The green part is in a linetype I happen to have with arrows -- it can be anything.]  All those differences could be programmed into property assignments in a defined command.

You can play with the spacing vs. height vs. offset from the path, and with the X offset depending on the length of the actual content and style of the text piece.  [It does have what may be a drawback for you, in that it requires a separate linetype definition for every text content you would need.]

[_anonandon]

like this, i know the text will have to be added separately in the appropriate layer for each line

[_anonandon]

i think having text as a line on top of the original line in a layer labelled text might be confusing?!

[Kent1Cooper]

---

@_anonandon wrote:

i think having text as a line on top of the original line in a layer labelled text might be confusing?!

---

It doesn't need to be on a different Layer.

Looking at your sample drawing, the approach I suggest has the huge advantage over your independent Text objects that if you change the route, as long as you change both in the same way, the labeling will update by itself.  As you show it would take a negative Y offset for the text inclusions, and a far greater spacing between them relative to the text height, but those are easy.  The one thing it cannot do is your placement of one of the Texts at the beginning of the route -- the positions of text inclusions closest to the ends will be affected by the length of the route.

[Moshe-A · Accepted solution]

@_anonandon  hi,

check this METXT command

enjoy

Moshe

(defun c:metxt (/ initialize prepare_pline readable_angle draw_text ; local functions
		  DIMSCL PREFERED-STYLE pick ename layer inter fchar endPrm endLen culmDist p0 p1 prm ang)

 (defun initialize ()
  (setq DIMSCL (getvar "dimscale"))
  (setq PREFERED-STYLE "Survey 100")

  (if (null (tblsearch "style" PREFERED-STYLE))
   (command "style" PREFERED-STYLE "simplex" 0 1 0 "_no" "_no")
  )
 ); initialize

  
 (defun prepare_pline (/ m0 m1 m2)
  (setq m0 (vlax-curve-getClosestPointTo ename (cadr pick)))
  (setq m1 (vlax-curve-getStartPoint ename))
  (setq m2 (vlax-curve-getEndPoint ename))

  ; reverse polyline if user picked close to end pt
  (if (< (distance m0 m2) (distance m0 m1))
   (command "._pedit" ename "_reverse" "")
  )
 ); prepare_pline

   
 (defun readable_angle (a0)
  (if (and (> a0 (* pi 0.5)) (< a0 (* pi 1.5)))
   (+ a0 pi)
   a0)
 ); readable_angle 


 (defun draw_text (m0 hgt ang oba txt LAY)
  (entmakex
    (list
     '(0 . "TEXT")
     '(100 . "AcDbEntity")
     '(100 . "AcDbText")
      (cons '8 lay)
      (cons '10 m0) ; dummy
      (cons '40 hgt)
      (cons '11 m0) ; middle point
      (cons '7 PREFERED-STYLE) ; text style
      '(72 . 4) 
      '(73 . 2)
      (cons '50 ang)
      (cons '51 oba)  ; obllique angle
      (cons '1 txt) ; value
    ); list
  ); entmakex
 ); draw_text  
 

 ; here start c:metxt
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (initialize)
  
 (if (and
       (setq pick (entsel "\nPick polyline: "))
       (setq ename (car pick))
       (wcmatch (cdr (assoc '0 (entget ename))) "POLYLINE,LWPOLYLINE")
       (not (vlax-curve-isClosed ename))    ; reject close polyline
       (setq layer (cdr (assoc '8 (entget ename))))
       (setq inter (getdist "\nSpecify interval distance: "))
       (setq fchar (getString "\nSpecify fixed character: "))
     )
  (progn
   (prepare_pline) ; check polyline
   (setq endPrm (vlax-curve-getEndParam ename))
   (setq endLen (vlax-curve-getDistAtParam ename endPrm))

   (setq culmDist 0.0) ; cumulative distance
   (while (< culmDist endLen)
    (setq p0  (vlax-curve-getPointAtDist ename culmDist))
    (setq prm (vlax-curve-getParamAtDist ename culmDist))

    (if (setq p1 (vlax-curve-getFirstDeriv ename prm))
     (progn
      (setq ang (angle '(0.0 0.0 0.0) p1))
      (draw_text (polar p0 (- ang (/ pi 2)) (* DIMSCL 0.17 1.5)) (* DIMSCL 0.17) (readable_angle ang) 0.0 fchar layer)
     ); progn
    ); if
     
    (setq culmDist (+ culmDist inter))
   ); while
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:metxt

[_anonandon]

thanks, this is great but why reverse some polylines? I need them the same direction!

[_anonandon]

thanks for metxt 🙂

I'm revisiting this as i've got hundreds of lines to label (i know a linetype is the best answer but I dont make the rules 😞

is there any advice how to revise metxt to select multiple polylines in one go??

[Moshe-A]

@_anonandon  hi,

With current METXT command, by picking the pline you specify from which side to start labeling the polyline, how would you do that with multiple selected plines?  isn't this important or you do not care?

please open a new thread

Moshe

[_anonandon]

ah ok! i didn't appreciate this specified the side of the label.

it's not important which side of the line the text goes (or more important to do many lines in one go)

should I paste metxt into a new thread asking for this change??

[Moshe-A]

No need to copy & paste just new thread on your name

[Moshe-A · Accepted solution]

@_anonandon ,

my apology i did not notice it is you that open this thread, no need to open new

check this new routine

moshe

(defun c:metxt2 (/ initialize readable_angle draw_text ; local functions
		  DIMSCL PREFERED-STYLE ss ename inter fchar endPrm endLen layer culmDist p0 p1 prm ang)

 (defun initialize ()
  (setq DIMSCL (getvar "dimscale"))
  (setq PREFERED-STYLE "Survey 100")

  (if (null (tblsearch "style" PREFERED-STYLE))
   (command "style" PREFERED-STYLE "simplex" 0 1 0 "_no" "_no")
  )
 ); initialize

  
 (defun readable_angle (a0)
  (if (and (> a0 (* pi 0.5)) (< a0 (* pi 1.5)))
   (+ a0 pi)
   a0)
 ); readable_angle 


 (defun draw_text (m0 hgt ang oba txt LAY)
  (entmakex
    (list
     '(0 . "TEXT")
     '(100 . "AcDbEntity")
     '(100 . "AcDbText")
      (cons '8 lay)
      (cons '10 m0) ; dummy
      (cons '40 hgt)
      (cons '11 m0) ; middle point
      (cons '7 PREFERED-STYLE) ; text style
      '(72 . 4) 
      '(73 . 2)
      (cons '50 ang)
      (cons '51 oba)  ; obllique angle
      (cons '1 txt) ; value
    ); list
  ); entmakex
 ); draw_text  
   

 ; here start c:metxt2
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (initialize)
  
 (if (and
       (setq ss (ssget '((0 . "polyline,lwpolyline") (70 . 0))))
       (setq inter (getdist "\nSpecify interval distance: "))
       (setq fchar (getString "\nSpecify fixed character: "))
     )
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq endPrm (vlax-curve-getEndParam ename))
   (setq endLen (vlax-curve-getDistAtParam ename endPrm))

   (setq culmDist 0.0) ; cumulative distance
   (while (< culmDist endLen)
    (setq layer (cdr (assoc '8 (entget ename)))) 
    (setq p0  (vlax-curve-getPointAtDist ename culmDist))
    (setq prm (vlax-curve-getParamAtDist ename culmDist))

    (if (setq p1 (vlax-curve-getFirstDeriv ename prm))
     (progn
      (setq ang (angle '(0.0 0.0 0.0) p1))
      (draw_text (polar p0 (- ang (/ pi 2)) (* DIMSCL 0.17 1.5)) (* DIMSCL 0.17) (readable_angle ang) 0.0 fchar layer)
     ); progn
    ); if
     
    (setq culmDist (+ culmDist inter))
   ); while

  ); foreach
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:metxt2
   

[_anonandon]

even better!

for some reason it doesn't select linetype generation enabled polylines?? but I can work with that

[Moshe-A]

---

@_anonandon wrote:

even better!

for some reason it doesn't select linetype generation enabled polylines?? but I can work with that

---

Yes you are right but i can fix this. i saw above you were 'complaining' on the side of the text, would you like to move it to the other side?

right now it puts the label at the segment angle minus 90 degrees i can move it to plus 90.

Moshe

[_anonandon]

I'm happy with the text on either side of the line.

it would be good if the text labels were made in the current layer, not the line layer

and really good!! if the text was placed in the centre of the line and at intervals from there.

current:

t___t___t___
ideal:

__t___t___t__

rob

[Sea-Haven]

Back to Kents idea, a linetype can have more than one object as part of the definition.

*BATTING,Batting SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
A,.00254,-2.54,[BAT,ltypeshp.shx,x=-2.54,s=2.54],-5.08,[BAT,ltypeshp.shx,r=180,x=2.54,s=2.54],-2.54
*BATTING2,Batting SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
A,.00254,-2.54,[BAT,ltypeshp.shx,x=-2.54,s=2.54],-5.08,[BOX,ltypeshp.shx,x=-2.54,s=2.54],-2.54