Jump to content

Create lisp code for text above polyline

karfung

By karfung
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

karfung Rookie

karfung

Posted
Posted

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. 

 

Saxlle Community Regular

Saxlle

Posted
Posted (edited)

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 by Saxlle
  • Thanks 1
karfung Rookie

karfung

Posted
  • Author
Posted
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. 

 

Danielm103 Community Regular

Danielm103

Posted
Posted 
I am from Malaysia.

 

Land of Durian, yummy

karfung Rookie

karfung

Posted
  • Author
Posted (edited)
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 by karfung
karfung Rookie

karfung

Posted
  • Author
Posted
9 minutes ago, Danielm103 said: 
I am from Malaysia.

 

Land of Durian, yummy

 

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

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...