Jump to content

Recommended Posts

Posted

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

Posted

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.

  • Like 3
Posted

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

 

 

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

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.

×
×
  • Create New...