Lisp for to get y value of police based on datum value and line.

October 17

Dear Members,

I have a ployline with dautm text value and datum line , I want text label of pline start vertex, intersection pont and end vertex, based on datum.

If any have plz share need only y value, elevation, level of pline .

Thanks

See attached cad file

Thanks

POLYLINE Y VALUE.dwg

October 17

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works.

The code:

(prompt "\nTo run a LISP type: yval")
(princ)

(defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang)

  (setq old_osmode (getvar 'osmode))
    
  (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
  
  (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline))))))
    
    (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n")
    (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
    
    )
  
  (setq spt_pline (vlax-curve-getStartPoint pline)
	ept_pline (vlax-curve-getEndPoint pline)
	)
  
  (if (> (car spt_pline) (car ept_pline))
    
    (progn
      
      (command-s "_reverse" pline "")
      
      (setq spt_pline (vlax-curve-getStartPoint pline)
	    ept_pline (vlax-curve-getEndPoint pline)
	    )
      )
    
    )
  
  (setq datum_line (car (entsel "\nSelect Datum Line:")))
  
  (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line))))))
    
    (prompt "\nSelected entity must be LINE. Try again...\n")
    (setq datum_line (car (entsel "\nSelect Datum Line:\n")))
    
    )
  
  (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line))
	yval_start_pline (- (cadr spt_pline) yval_datum_line)
	yval_end_pline (- (cadr ept_pline) yval_datum_line)
	)
  
  (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n"))

  (setvar 'osmode 0)
   
  (setq datum_value (car (entsel "\nSelect Datum value:")))
  
  (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value))))
    
    (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T))
    
    (setq datum_value (cdr (assoc 1 (entget datum_value))))
    
    )

  (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline)
	ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline)
	)
  
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline)))

  (princ "\nSelect intersecting lines:")
  
  (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID")))
	len (sslength intersecting_lines)
	i 0
	)
  
  (while (< i len)
    
    (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  dist (distance int_pt_pline int_pt_datum_line)
	  yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))
	  ang (angle yval_position int_pt_pline)
	  i (1+ i)
	  )
    
    (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ dist (atof datum_value)) 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
    
    )

  (setvar 'osmode old_osmode)

  (prompt "\nAn elevation values were added!")
  (princ)
  
  )


;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

  (vl-load-com)
  
    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

The short video:

Best regards.

Edited October 19 by Saxlle
Added "datum value" into the counting.

October 17

This takes into account a datum and scale, metric only. You need dummy text as it updates the text. Note this was written in 2014.

SurfaceRL.lsp

October 18

13 hours ago, Saxlle said:

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works.

The code:

(prompt "\nTo run a LISP type: yval")
(princ)

(defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang)

  (setq old_osmode (getvar 'osmode))
    
  (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
  
  (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline))))))
    
    (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n")
    (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
    
    )
  
  (setq spt_pline (vlax-curve-getStartPoint pline)
	ept_pline (vlax-curve-getEndPoint pline)
	)
  
  (if (> (car spt_pline) (car ept_pline))
    
    (progn
      
      (command-s "_reverse" pline "")
      
      (setq spt_pline (vlax-curve-getStartPoint pline)
	    ept_pline (vlax-curve-getEndPoint pline)
	    )
      )
    
    )
  
  (setq datum_line (car (entsel "\nSelect Datum Line:")))
  
  (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line))))))
    
    (prompt "\nSelected entity must be LINE. Try again...\n")
    (setq datum_line (car (entsel "\nSelect Datum Line:\n")))
    
    )
  
  (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line))
	yval_start_pline (- (cadr spt_pline) yval_datum_line)
	yval_end_pline (- (cadr ept_pline) yval_datum_line)
	)
  
  (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n"))

  (setvar 'osmode 0)
   
  (setq datum_value (car (entsel "\nSelect Datum value:")))
  
  (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value))))
    
    (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T))
    
    (setq datum_value (cdr (assoc 1 (entget datum_value))))
    
    )

  (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline)
	ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline)
	)
  
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline)))

  (princ "\nSelect intersecting lines:")
  
  (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID")))
	len (sslength intersecting_lines)
	i 0
	)
  
  (while (< i len)
    
    (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  dist (distance int_pt_pline int_pt_datum_line)
	  yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))
	  ang (angle yval_position int_pt_pline)
	  i (1+ i)
	  )
    
    (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos dist 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
    
    )

  (setvar 'osmode old_osmode)

  (prompt "\nAn elevation values were added!")
  (princ)
  
  )


;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

  (vl-load-com)
  
    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

The short video:

Best regards.

Thanks for your help sir, one issue I notice, if I change the datum value and keep datum line same ,value of intersection point not coming accurate, only start vertex and and vertex is accurate. Note : Same section but change datum value.

October 18

@Ish, if you don't mind, can you please attach video, gif, picture, etc. of the problem which you issued, because I'm not sure to fully understand the problem. Thanks

October 18

2 hours ago, Saxlle said:

@Ish, if you don't mind, can you please attach video, gif, picture, etc. of the problem which you issued, because I'm not sure to fully understand the problem. Thanks

Sir, just I change date value 0 to 1, because dautm value and line is always varies.

Program working perfectly for zero 0 datum value and line, if dautm value and line change, not getting accurate level , this attachment. Thanks

DATUM VALUE CHANGE.dwg

October 19

@Ish, I modified the code from the fist post, just copy it again and try it.

Now, you will get the desired elevation values (picture 1, the red rectangle).

Best regards.

2025-10-26T19:22:00Z

On 10/17/2025 at 5:12 PM, Saxlle said:

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works.

The code:

(prompt "\nTo run a LISP type: yval")
(princ)

(defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang)

  (setq old_osmode (getvar 'osmode))
    
  (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
  
  (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline))))))
    
    (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n")
    (setq pline (car (entsel "\nSelect Polyline to get an Elevation:")))
    
    )
  
  (setq spt_pline (vlax-curve-getStartPoint pline)
	ept_pline (vlax-curve-getEndPoint pline)
	)
  
  (if (> (car spt_pline) (car ept_pline))
    
    (progn
      
      (command-s "_reverse" pline "")
      
      (setq spt_pline (vlax-curve-getStartPoint pline)
	    ept_pline (vlax-curve-getEndPoint pline)
	    )
      )
    
    )
  
  (setq datum_line (car (entsel "\nSelect Datum Line:")))
  
  (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line))))))
    
    (prompt "\nSelected entity must be LINE. Try again...\n")
    (setq datum_line (car (entsel "\nSelect Datum Line:\n")))
    
    )
  
  (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line))
	yval_start_pline (- (cadr spt_pline) yval_datum_line)
	yval_end_pline (- (cadr ept_pline) yval_datum_line)
	)
  
  (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n"))

  (setvar 'osmode 0)
   
  (setq datum_value (car (entsel "\nSelect Datum value:")))
  
  (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value))))
    
    (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T))
    
    (setq datum_value (cdr (assoc 1 (entget datum_value))))
    
    )

  (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline)
	ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline)
	)
  
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline)))

  (princ "\nSelect intersecting lines:")
  
  (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID")))
	len (sslength intersecting_lines)
	i 0
	)
  
  (while (< i len)
    
    (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone)))
	  dist (distance int_pt_pline int_pt_datum_line)
	  yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))
	  ang (angle yval_position int_pt_pline)
	  i (1+ i)
	  )
    
    (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ dist (atof datum_value)) 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline)))
    
    )

  (setvar 'osmode old_osmode)

  (prompt "\nAn elevation values were added!")
  (princ)
  
  )


;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

  (vl-load-com)
  
    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

The short video:

Best regards.

hi This is a very good lisp, can this be still upgraded to show the station of the selected lines also, at a certain distance south. like 20 or something.

Sign In

Lisp for to get y value of police based on datum value and line.

Recommended Posts

Ish

Saxlle

BIGAL

Ish

Saxlle

Ish

Saxlle

symoin

Join the conversation

Tutorials

Forums

Activity