Chainage Marking on Plan View

[dek]

Greetings

New in Chainages,.

 

Is there a LSP that can Mark or Check the  specified marking  on a existing chainage

 

its like there Is a item on the left and when I draw a line, he will specify what chainage it was on

 

a chainage marking on Plan view

 

I browse already the forum and ended up with chm.lsp which only good for elevation chainages

 

 

Chainage Checking & Marking.dwg

[dtkell]

I am not sure if this will do what you want but look for this: "StationingPolyline.LSP" by Raymond RIZKALLAH.

[dek]

I got a look at stationing polyline.

 

 the command ST3 is cool, however it only marks the from point A length to point B length of the existing length of polyline,.

how about if there is already a imaginary length,.

 

like the one in my picture,, there is already of 5460 existing chainage,,

 

 

[BIGAL]

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)

 

 

[ingoscarmora]

ESPERO SEA LO QUE NECESITAS COMPRARTO PARA QUE ALQUIEN PUEDA MODIFICAR EL ARCHIVO PARA QUE EL TEXTO APAREZCA COMO EN EL SIGUIENTE

EJEMPLO :  PK 12+450,45 m.

 

(vl-load-com)

(defun c:opr()

	(setvar "cmdecho" 0)
	(Setq CambioInicio "No")
	
	(initget "Cambiar")
	(setq ent (entsel "\nSeleccione la polilinea eje [Cambiar inicio de eje]: "))
	
	(if (= ent "Cambiar")
		(progn
			(Setq CambioInicio "Si")
			(princ "\nSe ha cambiado el inicio del eje.")
			(setq ent (car (entsel "\nSeleccione la polilinea eje [Cambiar inicio de eje]: ")))
			(setq PlineObj (vlax-ename->vla-object ent))
		)
		(progn
			(setq ent (car ent))
			(setq PlineObj (vlax-ename->vla-object ent))
		)
	)
	
	(if (null ProgDef)(setq ProgDef 0))
	(setq ProgInicial (getreal (strcat "\nIngrese progresiva inicial del eje <" (rtos ProgDef 2 2) ">: ")))
	(if (null ProgInicial)(setq ProgInicial ProgDef))(setq ProgDef ProgInicial)
	
	(while 
		(setq Punprog (getpoint "\nIndique el punto donde obtener la progresiva: "))
		(setq LongitudHallada (vlax-curve-getDistAtPoint PlineObj Punprog))
		
		;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		
		(if (= CambioInicio "Si")
			(setq param (vlax-curve-getSTARTParam PlineObj))
			(setq param (vlax-curve-getENDParam PlineObj))
		)
		
		(setq len   (vlax-curve-getDistAtParam PlineObj param))

		(if (= CambioInicio "Si")
			(setq hlen (+ len LongitudHallada))
			(setq hlen (- len LongitudHallada))
		)

		;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
		
		(if (not (null LongitudHallada))
			(progn 
				(setq PAngTexto (getpoint "\nIndique el punto angulo del texto a insertar: "))
				(setq AngTexto (angle Punprog PAngTexto))
				
				(command "line" Punprog PAngTexto "")
				(setq entLine (entlast))
				(setq entLineaVla (vlax-ename->vla-object entLine))
				
				;(setq texto (rtos (+ ProgInicial LongitudHallada) 2 2))
				(setq texto (rtos (+ ProgInicial hlen) 2 2))
				
				(command "text" Punprog "2.0"  AngTexto texto )
				
				(setq entText (entlast))
				(setq entTextoVla (vlax-ename->vla-object entText))
				
				(vla-put-Rotation entTextoVla (vla-get-Angle entLineaVla))
				
				;(command "erase" entLine "")
				;(command "erase" entLine "")
				;(princ (strcat "\nProgresiva: " (rtos (+ ProgInicial LongitudHallada) 2 2)) )
			)
			(ALERT "El punto indicado no debe de encontrarse fuera del eje." )
		)
	)
(setvar "cmdecho" 0)
(princ)

)

 

Obtener_la_longitud_o_progresiva_de_una_polilinea-rev1-2.lsp

[stealtahspectah]

hm ST3 command works great, I would like to use it in kilometres instead of metres ... my drawing units are usually set to meters so isntead of 100, 200, 300 etc I would like to get 0,100 0,200 0,300 values. Any ideas will be appreciated