Leaderboard

There are numerous chainage lisps out there they all use the getpointatdist or the opposite the getdistatpoint VL functions, so you can pick a point on a pline and get its distance back to start point. You could also do add a chainage where the start point is not 0.0 The problem was with your dwg the white broken lines were not a continuous pline. You also need to look at how to apply what is the start chainage so it can be added to the distance retrieved. Is the chainages of known points always there as can do a read text get chainage and what the start chainage is ? Hence delay in posting code. They are mtext as well so a bit more to strip out the values. I have allowed for "Ch 5000.5" etc. It is expected that as the chainages are labelled the pline has a correct start point. Follow the prompts pick pline, pick existing chainage text pick corresponding chainage point, then pick points, press Enter to exit. I will leave it to you make sure text style and side is correct. ; label chainage points ; big thanks to lee-mac for sub routines. ; By alan H Oct 2020 ;;-------------------=={ Parse Numbers }==--------------------;;` ;; ;; ;; Parses a list of numerical values from a supplied string. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; s - String to process ;; ;;------------------------------------------------------------;; ;; Returns: List of numerical values found in string. ;; ;;------------------------------------------------------------;; (defun LM:ParseNumbers ( s ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar (function (lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) ) (cons nil l) l (append (cdr l) (list nil)) ) ) ")" ) ) ) (vl-string->list s) ) ) ;;-------------------=={ 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 ) (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 ) ) ) ) (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt ) ) ) ) ;; Make Readable - Lee Mac ;; Returns a given angle corrected for text readability (defun lm:makereadable (a) ((lambda (a) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (+ a pi) a ) ) (rem (+ a pi pi) (+ pi pi)) ) ) (defun c:test ( / pt oldsnap obj obj2 ch stch dist ang) (setq oldsnap (getvar 'osmode) oldaunits (getvar 'aunits)) (setvar 'aunits 3) (setq obj2 (vlax-ename->vla-object (car (entsel "\nPick Pline ")))) (setq obj (vlax-ename->vla-object (car (entsel "\nPick Chainage text ")))) (setq ch (nth 0 (LM:ParseNumbers (LM:UnFormat (vla-get-textstring obj) nil) ))) (setq pt (getpoint "Pick text chainage point ")) (setq dist (vlax-curve-getdistatpoint obj2 pt)) (setq stch (- ch dist)) (while (setq pt (getpoint "\pick point on pline for new chainage")) (setvar 'osmode 0) (setq ang (- (alg-ang obj2 pt) (/ pi 2.0))) (setq ang (lm:makereadable ang)) (command "text" pt 1.25 ang (rtos (+ stch (vlax-curve-getdistatpoint obj2 pt)) 2 2)) (setvar 'osmode oldsnap) (setvar 'aunits oldaunits) ) (princ) ) (c:test)