station and distance of points

can i get the desired result ??? i have attached a sample drawing.is it possible by lisp or vba??????

need help 200000.dwg

Pretty sure this question was asked not long ago try searching here using offset. It can be done in CIV3d else it will be a lisp chainage and offset.

can you provide me the lisp me using auto cad 2007.pls give me that one.

Hi, alignment should be 2D (plan view) right?

not fully tested, must be lots of bugs... (vlax-curve* iteration default in 3D, it also never gets a secant angle at polyline vertex ) please try first.

command: STALBL

(if (not *ch*)
 (setq *ch* 0.0)
 ) ;_ end of if

(defun c:STALBL  (/ *error* cl e obj ss l cor ch flatz)
[color="#696969"]http://www.cadtutor.net/forum/showthread.php?88888-station-and-distance-of-points[/color]
;hanhphuc 27/09/14
 (defun *error* (msg)
   (if	(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*UNKNOWN*")) ;v1.0
     (princ (strcat "\nError: " msg))
     ) ;_ end of if
   (princ)
   ) ;_ end of defun
 
 (setq  ch    (getreal (strcat "\nStart station CH <" (rtos *ch* 2 3) "> ? : "))
*ch*  (if ch
	ch
	*ch*
	) ;_ end of if
flatz '((p) (reverse (cons 0.0 (cdr (reverse p)))))
) ;_ end of setq
 (if (and (setq cl (car (entsel "\nPick horizontal alignment.."))); <--- LWpolyline
   (setq ss (ssget "_:L" '((0 . "POINT,LINE,CIRCLE,ARC,LWPOLYLINE")))); [color="red"]<---  this can be modified[/color]
   ) ;_ end of and
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     (mapcar ''((x)
	 (entmakex (mapcar 'cons
			   '(0 100 100 1 10 40 8 7 71)
			   (list "MTEXT"
				 "AcDbEntity"
				 "AcDbMText"
				 (strcat "STA  : "
					 ([color="red"][b]rtosta[/b][/color] (car x) 2 3)
					 "\\POFFSET: "
					 (rtos (abs (cadr x)) 2 3)
					 (if (minusp (cadr x))
					   " L"
					   " R"
					   ) ;_ end of if
					 ) ;_ end of strcat
				 (caddr x)
				 (getvar "textsize")
				 "STALBL"
				 (getvar "textstyle")
				 5
				 ) ;_ end of list
			   ) ;_ end of mapcar
		   ) ;_ end of entmake
	 ) ;_ end of lambda
      ((lambda (lst vo sta / ang pa dir )
	 (vl-remove
	  nil
	  (mapcar
	   ''((p / d l)
	      (setq
	       p
	       (if
		(> (length p) 2)
		(flatz p)
		p
		) ;_ end of if
	       d
	       (vlax-curve-getDistAtPoint vo (setq pa (flatz (vlax-curve-getClosestPointTo vo p nil))))
	       ) ;_ end of setq
	      (if
	       (and (> d 0.) (< d (vla-get-length vo)))
	       (progn
		(setq
		 ang
		 (angle (vlax-curve-getFirstDeriv vo (vlax-curve-getParamAtPoint vo pa)) '(0.0 0.0 0.0))
		 dir
		 (if
		  (<= ang (* pi 1.5))
		  (- (* pi 1.5) ang)
		  (- (* pi 3.5) ang)
		  ) ;_ end of if
		 ) ;_ end of setq
		
		 (list
		  (+ sta d)
		  (- (* (- (car p) (car pa)) (cos dir)) (* (- (cadr p) (cadr pa)) (sin dir)))
		  p
		  ) ;_ end of list
		 
		) ;_ end of progn
	       ) ;_ end of if
	      )
	   lst
	   ) ;_ end of mapcar
	  ) ;_ end of vl-remove
	 )
	(progn (foreach	p '("Coordinates" "EndPoint" "StartPoint" "InsertionPoint" "Center" "TextPosition"
			    "FitPoints") ; <-- spine line
		 (setq obj (vlax-ename->vla-object e))
		 (if (vlax-property-available-p obj p)
		   (setq l (cons p l))
		   ) ;_ end of if
		 ) ;_ end of foreach
	       (setq cor (mapcar ''((p) (vlax-get obj p)) l))
	       (eval (cons 'cond
			   (reverse (vl-list* '(t cor)
					      (mapcar ''((a b)
							 (list
							  (list '= (cdr (assoc 0 (entget e))) a)
							  (cons
							   'quote
							   (list
							    ('((lst len opt / ls l i)
							       (setq
								i
								1
								l
								'()
								len
								(if
								 opt
								 (/ (length lst) len)
								 len
								 )
								)
							       (while
								lst
								(setq l (append l (list (car lst))))
								(if
								 (zerop (rem i len))
								 (setq
								  ls
								  (cons l ls)
								  l
								  nil
								  ) ; append
								 )
								(setq
								 i
								 (1+ i)
								 lst
								 (cdr lst)
								 )
								) ;_ end of foreach
							       (if
								l
								(append (reverse ls) (list l))
								(reverse ls)
								) ;_ end of if
							       )
							     (car cor)
							     b
							     nil
							     )
							    )
							   )
							  )
							 )
						      '("LWPOLYLINE" "POLYLINE" "LEADER" "SPLINE")
						      '(2 3 3 3)
						      ) ;_ end of mapcar
					      ) ;_ end of cons
				    ) ;_ end of reverse
			   ) ;_ end of cons
		     ) ;_ end of eval
	       ) ;_ end of progn
	(vlax-ename->vla-object cl)
	*ch*
	)
      ) ;_ end of mapcar
     ) ;_ end of foreach
   ) ;_ end of if
 (princ)
 ) ;_ end of defun

(princ "\nhanhphuc 2014. Label Station Offset. Command: STALBL")
(grtext -1 "STALBL.lsp v1.0 hanhphuc")
(princ)

This STA string format courtesy of ymg

;;http://www.theswamp.org/index.php?topic=45311.0
;; rtosta                     by ymg  September 2013                          ;
;;                                                                            ;
;; Arguments:   sta Real number to format as a Station                        ;
;;             unit 1 for Imperials,                                          ;
;;                  2 for Metrics.                                            ;
;;             prec Integer for number of decimals                            ;
;;                                                                            ;
;; Examples: (rtosta 0 1 0)  -> "0+00"   (rtosta 1328.325 1 2) -> "13+28.33"  ;
;;           (rtosta 0 2 0)  -> "0+000"  (rtosta 1328.325 2 2) -> "1+328.33"  ;
;;                                                                            ;
;; If sta is negative, format is as follow:                                   ;
;;                                       (rtosta -1328.325 1 2) -> "13-28.33" ;
;;                                       (rtosta -1328.325 2 2) -> "1-328.33" ;
;;                                                                            ;

(defun rtosta (sta unit prec / str a b dz)
 (setq dz (getvar 'dimzin))
 (setvar 'dimzin 0)
 (setq str (rtos (abs sta) 2 prec))
 (setvar 'dimzin dz)
 (while (< (strlen str)
    (if	(= prec 0)
      (+ unit 2)
      (+ prec (+ unit 3))
      ) ;_ end of if
    ) ;_ end of <
   (setq str (strcat "0" str))
   ) ;_ end of while
 (setq	a (if (= prec 0)
    (- (strlen str) unit)
    (- (strlen str) prec (+ unit 1))
    ) ;_ end of if
b (substr str 1 (- a 1))
a (substr str a)
) ;_ end of setq
 (strcat b
  (if (minusp sta)
    "-"
    "+"
    ) ;_ end of if
  a
  ) ;_ end of strcat
 ) ;_ end of defun

thanks too much hanhphuc sir.it is working great....can it modify little bit so that it will show the x and y coordinates of each points along with the offset distance and chainage...?

thanks too much hanhphuc sir.it is working great....can it modify little bit so that it will show the x and y coordinates of each points along with the offset distance and chainage...?

you are welcome, credit to ymg. i encourage you too learn too, so add this inside the previous code...

Try to locate & add / modify in red.. last end of defun

grey is existing code.

This option for add coordinates if you wish

[color="#696969"](defun c:STALBL  (/ *error* cl e obj ss l cor ch flatz)
...
...
...[/color]
[color="red"];USER Options
(setq On/Off t); t=ON,  ;(setq On/Off nil) = nil=OFF
 
(if (and On/Off (ssget "X" '((0 . "MTEXT")(8 . "STALBL"))))
 (vlax-for tx (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
   (setq str (vla-get-textstring tx))
   (vla-put-textstring
     tx
     (strcat str (if (wcmatch str "*X*,*Y*,*Z*") ""
      (apply 'strcat
	     (mapcar '(lambda (a b) (strcat a (rtos b 2 3)))
		     '("\\PX= " "\\PY= " "\\PZ= ")
		     (trans (vlax-get tx 'Insertionpoint) 0 1) ; thanx Tharwat 
		     ) ;_ end of mapcar
	    
	     ) ;v1.1
	)
      ) ;_ end of strcat
     ) ;_ end of vla-put-textstring
   ) ;_ end of vlax-for
 ) ;_ end of if[/color]

[color="#696969"]  (princ)
 ) ;_ end of defun

(princ "\nhanhphuc 2014. Label Station Offset. Command: STALBL")
(grtext -1 "STALBL.lsp v1.0 hanhphuc")
(princ)[/color]

Don't you think a bit messy if too much text with XYZ?

the x,y,z coordinates should be placed after every offset and chainages like first chainage say 0+500 then offset say 100L then X=xxxxxxxx then Y=xxxxxx then Z=xxxxxxx then i will try to export all from drawing to excel.how will it possible?

hanhphuc sir,,, WHERE TO PUT THAT CODE TO GET THE COORDINATES OF EVERY POINTS ....I CANT UNDERSTAND.PLS HELP ME .

I have attached sample drawing for your observation.pls help me

(STALBL)FOR OFFSET CHAINAGE (2).LSP

(STALBL)FOR OFFSET CHAINAGE111.LSP

NEED HELP 40000.dwg

hi anindya,

please don't make duplicated/similar post as the previous thread is still visible, this is confusing ?

In post#6 which i have updated how to put additional red codes in existing lisp

just copy & paste..

I merged your two threads.

Please do not create more than one thread per question, as mentioned, it creates confusion.

Respected sir where to paste that red portion?????????????....i am novice in case of lisp.PLS give me the full lisp with modification...plsssss.

hi anindya,

regardless knowing the code, LISP is just normal ascii characters.

you just need copy the red line locate the existing code then paste it.

This update is Optional: here

thanks sir... it is solved...thanks for your help.