Create lisp code for text above polyline

2026-01-18T05:49:56Z

Hi Team,
I wish to create a Lisp code that has the following conditions,

1). Create a mtext above the new draw polyline. The mtext shall be created in every segment of the polyline. The mtext to follows the direction of the polyline.

2). The mtext to be content "BD/1:200/3.0m" above the polyline. The 3.0m is the variable that refers to the length of the particular polyline segment length.

3). The mtext to be layer SNA-TXT and text height 1000.

Kindly advise the lisp code above. Thanks.

2026-01-18T11:16:40Z

Hi @karfung,

Try this and see if it fits to your needs:

; **********************************************************************************************
; Functions     :  PLMTXT
; Description   :  Add predefined text with length segment between two vertices on polyline
; Author        :  Saxlle
; Date          :  January 18, 2026
; **********************************************************************************************

(prompt "\nTo run a LISP type: PLMTXT")

(princ)

(defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment)

  (setq old_osmode (getvar 'osmode)

	cur_layer (getvar 'clayer)

	old_nomutt (getvar 'nomutt)
	
	height (getreal "\nEnter the text height <2.50>: ") ;; text height
	
	def_text "BD/1:200/" ;; default text
	
	)

  (if (= height nil)

    (setq height 2.50) ;; defaul text height, it can be changed

    )
  
  (setvar 'osmode 0)
  
  (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not

    (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be the current

    (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current

    )

  (setvar 'nomutt 1)

  (princ "\nSelect POLYLINES:")
    
  (setq ss (ssget (list (cons 0 "LWPOLYLINE")))
	len (sslength ss)
	plist (list)
	i 0
	)

  (setvar 'nomutt old_nomutt)

  (while (< i len)

    (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i)))))

    (cond

      ;; the first cond

      ((= dxf_70 0) ;; LWPOLYLINE is OPEN

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

	 )

      ) ;; end first cond
      

      ;; the second cond
      
      ((= dxf_70 1) ;; LWPOLYLINE is CLOSED

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     (setq n 0
		   k (1- k)
	           pt1 (nth k plist)
		   pt2 (nth n plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))
	 

       )

      ) ;; end second cond

    ) ;; end cond

    (setq i (1+ i))

  )

  (setvar 'osmode old_osmode) ;; restore osmode
      
  (setvar 'clayer cur_layer) ;; restore old layer
      
  (prompt "\nThe text was inserted!")
  
  (princ)
    
  )

  ;; Sub-function to get a proper text angle
  
  (defun ang_check_text (ang)

    (cond

      ((<= ang 1.57)

       (setq ang ang)

       )

      ((and (>= ang 1.57) (<= ang 3.14))

       (setq ang (+ ang pi))

       )

      ((and (>= ang 3.14) (<= ang 4.71))

       (setq ang (- ang pi))

       )

      ((>= ang 4.71)

       (setq ang ang)

       )
      
      )
    
    )

Also, see the short video example of how it works.

Best regards.

Edited 14 hours ago by Saxlle

2026-01-18T12:02:03Z

40 minutes ago, Saxlle said:

Hi @karfung,

Try this and see if it fits to your needs:

; **********************************************************************************************
; Functions     :  PLMTXT
; Description   :  Add predefined text with length segment between two vertices on polyline
; Author        :  Saxlle
; Date          :  January 18, 2026
; **********************************************************************************************

(prompt "\nTo run a LISP type: PLMTXT")

(princ)

(defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment)

  (setq old_osmode (getvar 'osmode)

	cur_layer (getvar 'clayer)

	old_nomutt (getvar 'nomutt)
	
	height (getreal "\nEnter the text height <2.50>: ") ;; text height
	
	def_text "BD/1:200/" ;; default text
	
	)

  (if (= height nil)

    (setq height 2.50) ;; defaul text height, it can be changed

    )
  
  (setvar 'osmode 0)
  
  (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not

    (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be the current

    (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current

    )

  (setvar 'nomutt 1)

  (princ "\nSelect POLYLINES:")
    
  (setq ss (ssget (list (cons 0 "LWPOLYLINE")))
	len (sslength ss)
	plist (list)
	i 0
	)

  (setvar 'nomutt old_nomutt)

  (while (< i len)

    (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i)))))

    (cond

      ;; the first cond

      ((= dxf_70 0) ;; LWPOLYLINE is OPEN

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

	 )

      ) ;; end first cond
      

      ;; the second cond
      
      ((= dxf_70 1) ;; LWPOLYLINE is CLOSED

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     (setq n 0
		   k (1- k)
	           pt1 (nth k plist)
		   pt2 (nth n plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))
	 

       )

      ) ;; end second cond

    ) ;; end cond

    (setq i (1+ i))

  )

  (setvar 'osmode old_osmode) ;; restore osmode
      
  (setvar 'clayer cur_layer) ;; restore old layer
      
  (prompt "\nThe text was inserted!")
  
  (princ)
    
  )

  ;; Sub-function to get a proper text angle
  
  (defun ang_check_text (ang)

    (cond

      ((<= ang 1.57)

       (setq ang ang)

       )

      ((and (>= ang 1.57) (<= ang 3.14))

       (setq ang (+ ang pi))

       )

      ((and (>= ang 3.14) (<= ang 4.71))

       (setq ang (- ang pi))

       )

      ((>= ang 4.71)

       (setq ang ang)

       )
      
      )
    
    )

Also, see the short video example of how it works.

Best regards.

@Saxlle Yeah, this is what I wanted. Really awesome and your prompt response. Thank you.

I am from Malaysia. May I know where you from? Thanks.

2026-01-18T12:20:16Z

I am from Malaysia.

Land of Durian, yummy

2026-01-18T12:29:02Z

1 hour ago, Saxlle said:

Hi @karfung,

Try this and see if it fits to your needs:

; **********************************************************************************************
; Functions     :  PLMTXT
; Description   :  Add predefined text with length segment between two vertices on polyline
; Author        :  Saxlle
; Date          :  January 18, 2026
; **********************************************************************************************

(prompt "\nTo run a LISP type: PLMTXT")

(princ)

(defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment)

  (setq old_osmode (getvar 'osmode)

	cur_layer (getvar 'clayer)

	old_nomutt (getvar 'nomutt)
	
	height (getreal "\nEnter the text height <2.50>: ") ;; text height
	
	def_text "BD/1:200/" ;; default text
	
	)

  (if (= height nil)

    (setq height 2.50) ;; defaul text height, it can be changed

    )
  
  (setvar 'osmode 0)
  
  (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not

    (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be the current

    (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current

    )

  (setvar 'nomutt 1)

  (princ "\nSelect POLYLINES:")
    
  (setq ss (ssget (list (cons 0 "LWPOLYLINE")))
	len (sslength ss)
	plist (list)
	i 0
	)

  (setvar 'nomutt old_nomutt)

  (while (< i len)

    (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i)))))

    (cond

      ;; the first cond

      ((= dxf_70 0) ;; LWPOLYLINE is OPEN

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

	 )

      ) ;; end first cond
      

      ;; the second cond
      
      ((= dxf_70 1) ;; LWPOLYLINE is CLOSED

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     (setq n 0
		   k (1- k)
	           pt1 (nth k plist)
		   pt2 (nth n plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (distance pt1 pt2)
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))
	 

       )

      ) ;; end second cond

    ) ;; end cond

    (setq i (1+ i))

  )

  (setvar 'osmode old_osmode) ;; restore osmode
      
  (setvar 'clayer cur_layer) ;; restore old layer
      
  (prompt "\nThe text was inserted!")
  
  (princ)
    
  )

  ;; Sub-function to get a proper text angle
  
  (defun ang_check_text (ang)

    (cond

      ((<= ang 1.57)

       (setq ang ang)

       )

      ((and (>= ang 1.57) (<= ang 3.14))

       (setq ang (+ ang pi))

       )

      ((and (>= ang 3.14) (<= ang 4.71))

       (setq ang (- ang pi))

       )

      ((>= ang 4.71)

       (setq ang ang)

       )
      
      )
    
    )

Also, see the short video example of how it works.

Best regards.

@Saxlle Could you do me a favour to amend the lisp code as following,

1). My default layout will be in unit mm. Could the length value of the polyline be divided by 1000?

2). The length value of the polyline is to be an integer, and any decimal is to be increased to 1.

Kindly assist to amend the lisp code. Thanks.

Edited 13 hours ago by karfung

2026-01-18T12:30:36Z

9 minutes ago, Danielm103 said:
I am from Malaysia.
Land of Durian, yummy

Please contact me when you reach here. I buy you durian.

2026-01-18T16:06:08Z

You're welcome @karfung . I'm from Serbia.

I have made changes to the code, please try it now (I hope I understand your requirements correctly). If it's not, try to change in sub-function "fix_value" the value from "500" to any other to get desired result. The fix function round up the real number into the nearest smallest integer number (for e.g. if you have a 3.70 m, and when you add 0.50 m, you will get 4.20 m, but using fix function which is an AutoLISP Core Function, you will get 4.0 m, also if you have 4.70 m, you will also get 4.0 m). Just an explanation to understand the logic.

; **************************************************************************************************
; Functions     :  PLMTXT
; Sub-functions :  ang_check_text, fix_value
; Description   :  Add predifined text with the length segment between two vertices on polyline
; Author        :  Saxlle
; Date          :  January 18, 2026
; **************************************************************************************************

(prompt "\nTo run a LISP type: PLMTXT")

(princ)

(defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment)

  (setq old_osmode (getvar 'osmode)

	cur_layer (getvar 'clayer)

	old_nomutt (getvar 'nomutt)
	
	height (getreal "\nEnter the text height <2.50>: ") ;; text height
	
	def_text "BD/1:200/" ;; default text
	
	)

  (if (= height nil)

    (setq height 2.50) ;; defaul text height, it can be changed

    )
  
  (setvar 'osmode 0)
  
  (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not

    (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be current

    (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current

    )

  (setvar 'nomutt 1)

  (princ "\nSelect POLYLINES:")
    
  (setq ss (ssget (list (cons 0 "LWPOLYLINE")))
	len (sslength ss)
	plist (list)
	i 0
	)

  (setvar 'nomutt old_nomutt)

  (while (< i len)

    (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i)))))

    (cond

      ;; the first cond

      ((= dxf_70 0) ;; LWPOLYLINE is OPEN

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

	 )

      ) ;; end first cond
      

      ;; the second cond
      
      ((= dxf_70 1) ;; LWPOLYLINE is CLOSED

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     (setq n 0
		   k (1- k)
	           pt1 (nth k plist)
		   pt2 (nth n plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))
	 

       )

      ) ;; end second cond

    ) ;; end cond

    (setq i (1+ i))

  )

  (setvar 'osmode old_osmode) ;; restore osmode
      
  (setvar 'clayer cur_layer) ;; restore old layer
      
  (prompt "\nThe text was inserted!")
  
  (princ)
    
  )

  ;; Sub-function to get a proper text angle
  
  (defun ang_check_text (ang)

    (cond

      ((<= ang 1.57)

       (setq ang ang)

       )

      ((and (>= ang 1.57) (<= ang 3.14))

       (setq ang (+ ang pi))

       )

      ((and (>= ang 3.14) (<= ang 4.71))

       (setq ang (- ang pi))

       )

      ((>= ang 4.71)

       (setq ang ang)

       )
      
      )
    
    )

  ;; Sub-function to round up number to the whole integer
  
  (defun fix_value (val)

    (if (not (minusp val))

      (setq val (fix (+ val 500))) ;; 500 mm equal to 0.50 m

      (setq val (fix (- val 500))) ;; 500 mm equal to 0.50 m

      )
    
    )

Best regards.

2026-01-18T16:09:28Z

I'v never taste the Durian .

2026-01-18T20:43:44Z

4 hours ago, Saxlle said:

I'v never taste the Durian .

@Saxlle Is King of the fruit. Is local product from Southeast Asia.

4 hours ago, Saxlle said:

You're welcome @karfung . I'm from Serbia.

I have made changes to the code, please try it now (I hope I understand your requirements correctly). If it's not, try to change in sub-function "fix_value" the value from "500" to any other to get desired result. The fix function round up the real number into the nearest smallest integer number (for e.g. if you have a 3.70 m, and when you add 0.50 m, you will get 4.20 m, but using fix function which is an AutoLISP Core Function, you will get 4.0 m, also if you have 4.70 m, you will also get 4.0 m). Just an explanation to understand the logic.

; **************************************************************************************************
; Functions     :  PLMTXT
; Sub-functions :  ang_check_text, fix_value
; Description   :  Add predifined text with the length segment between two vertices on polyline
; Author        :  Saxlle
; Date          :  January 18, 2026
; **************************************************************************************************

(prompt "\nTo run a LISP type: PLMTXT")

(princ)

(defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment)

  (setq old_osmode (getvar 'osmode)

	cur_layer (getvar 'clayer)

	old_nomutt (getvar 'nomutt)
	
	height (getreal "\nEnter the text height <2.50>: ") ;; text height
	
	def_text "BD/1:200/" ;; default text
	
	)

  (if (= height nil)

    (setq height 2.50) ;; defaul text height, it can be changed

    )
  
  (setvar 'osmode 0)
  
  (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not

    (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be current

    (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current

    )

  (setvar 'nomutt 1)

  (princ "\nSelect POLYLINES:")
    
  (setq ss (ssget (list (cons 0 "LWPOLYLINE")))
	len (sslength ss)
	plist (list)
	i 0
	)

  (setvar 'nomutt old_nomutt)

  (while (< i len)

    (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i)))))

    (cond

      ;; the first cond

      ((= dxf_70 0) ;; LWPOLYLINE is OPEN

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

	 )

      ) ;; end first cond
      

      ;; the second cond
      
      ((= dxf_70 1) ;; LWPOLYLINE is CLOSED

       (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i))))
	     dataList (list)
	     n 0
	     k 1
	     )

       (repeat (setq l (length plist))

	 (if (< k l)

	     (setq pt1 (nth n plist)
		   pt2 (nth k plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   n (1+ n)
		   k (1+ k)
		   )
	   
	     (setq n 0
		   k (1- k)
	           pt1 (nth k plist)
		   pt2 (nth n plist)
		   midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5))
		   ang (ang_check_text (angle pt1 pt2))
		   dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m
		   npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height)
		   dataList (append (list (list npt ang dist)) dataList)
		   )
	   
	     )

	 )

       (setq dataList (reverse dataList)
	     n 0
	     )

       (repeat (length dataList)

	 (setq pt (car (nth n dataList))
	       ang (cadr (nth n dataList))
	       lenSegment (caddr (nth n dataList))
	       n (1+ n)
	       )

	 (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))
	 

       )

      ) ;; end second cond

    ) ;; end cond

    (setq i (1+ i))

  )

  (setvar 'osmode old_osmode) ;; restore osmode
      
  (setvar 'clayer cur_layer) ;; restore old layer
      
  (prompt "\nThe text was inserted!")
  
  (princ)
    
  )

  ;; Sub-function to get a proper text angle
  
  (defun ang_check_text (ang)

    (cond

      ((<= ang 1.57)

       (setq ang ang)

       )

      ((and (>= ang 1.57) (<= ang 3.14))

       (setq ang (+ ang pi))

       )

      ((and (>= ang 3.14) (<= ang 4.71))

       (setq ang (- ang pi))

       )

      ((>= ang 4.71)

       (setq ang ang)

       )
      
      )
    
    )

  ;; Sub-function to round up number to the whole integer
  
  (defun fix_value (val)

    (if (not (minusp val))

      (setq val (fix (+ val 500))) ;; 500 mm equal to 0.50 m

      (setq val (fix (- val 500))) ;; 500 mm equal to 0.50 m

      )
    
    )

Best regards.

@Saxlle Could remove the decimal .00 (2 zero). Eventually, show the integer with unit m only. Kindly advise. Thanks.

2026-01-18T21:56:10Z

Sure @karfung, but I will leave you to do that (I'm writing from the phone).

This is the hint, find it everywhere in the code:

(entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang)
			(cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))))

Find this part inside:

Replace this part:

(cons 1 (strcat def_text (rtos lenSegment 2 2) " m"))

With this:

(cons 1 (strcat def_text (itoa lenSegment) " m"))

and you will get the whole integer without the decimal part.

I've heard the Durian, but never taste it. If I ever come to Malaysia, I will taste it .

Best regards.

2026-01-19T00:03:47Z

The same, but more condensed...

(vl-load-com)
(defun c:label ( / l_var js htx AcDoc Space nw_style def_text n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha val_txt nw_obj)
  (setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS")))
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(4 3 0 2))
  (princ "\nSelect polylines.")
  (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelection is empty or not are LWPOLYLINE!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (cond
    ((null (tblsearch "LAYER" "SNA-TXT"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "SNA-TXT") 'color 7)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "STANDARD"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "STANDARD"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
      )
    )
  )
  (setq def_text "BD/1:200/")
  (repeat (setq n (sslength js))
    (setq
      obj (ssname js (setq n (1- n)))
      ename (vlax-ename->vla-object obj)
      pr -1
    )
    (repeat (fix (vlax-curve-getEndParam ename))
      (setq
        dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
        dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
        pt_start (vlax-curve-GetPointAtParam ename pr)
        pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
        seg_len (fix (* (- dist_end dist_start) 0.001))
        alpha (angle (trans pt_start 0 1) (trans pt_end 0 1))
        val_txt (strcat def_text (rtos seg_len 2 0) " m")
      )
      (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi)))
      (setq nw_obj
        (vla-addMtext Space
          (vlax-3d-point (setq pt (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (+ alpha (* pi 0.5)) (getvar "TEXTSIZE"))))
          0.0
          val_txt
        )
      )
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
        (list 8 (getvar "TEXTSIZE") 5 pt "STANDARD" "SNA-TXT" alpha)
      )
    )
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var)
  (prin1)
)

Sign In

Create lisp code for text above polyline

Recommended Posts

karfung

Saxlle

karfung

Danielm103

karfung

karfung

Saxlle

Saxlle

karfung

Saxlle

Tsuky

Join the conversation

Tutorials

Forums

Activity