chainage lisp to contour label lisp

Please help me edit this code.

It creates chainage along polyline. What I want is to change the "CH 0.00" to the elevation value of the polyline

(defun c:cr (/)
(vl-load-com)
(defun _Line (p b o)
      (entmake
 (append
   '((0 . "line")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (8 . "C-CTRL_TICK")
     (100 . "AcDbLine")
     )
   (list (cons 10 (polar p b o)))
   (list (cons 11 (polar p (+ b PI) o)))
   '((210 0.0 0.0 1.0))
   )
 )
 )
(defun _text (p b o h c)
      (entmake
 (append
   '((0 . "MTEXT")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (8 . "C-CTRL_TXT")
     (100 . "AcDbMText")
     )
   (list (cons 10 (polar p (+ b PI) o))
  )
   (list (cons 40 h))
   (list (cons 1 (strcat "CH "
    (if (setq ld (nth (strlen (rtos  c 3 0)) '(x   "")))
       ld "")
    (rtos c 2 2))))
   (list (cons 50 (+ b PI)))

     (list '(41 . 0)
     '(90 . 3)
     '(63 . 256)
     '(441 . 3935927) 
     '(71 . 4)
     '(72 . 5)
     (cons 7 (getvar "textstyle"))
     '(210 0.0 0.0 1.0)
     '(73 . 1)
     )
   )
 )
 )
(defun _ang (p1 p2)(+ (angle p1 p2) (/ PI 2.0)))

(setq dist (getdist "increment: "))
 (setq offset (getdist "tick size: "))
 (setq height (getdist "text height: "))
 (setq to (getdist "text offset: "))
 (setq ss (ssget)
count 0
dist dist
offset offset
height height
)
 (repeat (sslength ss)
   (setq ent    (ssname ss count)
  obj    (vlax-ename->vla-object ent)
  chainage dist
  )
   (_line (setq p (vlax-curve-getstartpoint obj))
   (setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))
    offset)
   (_text p bearing to height 0.0)
   (while
     (and
(setq point1 (vlax-curve-getPointAtDist obj chainage))
(setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
)
      (setq bearing (+ (angle point1 point2) (/ PI 2.0)))
      (_line point1 bearing offset)
      (_text point1 bearing to height chainage)

      (setq chainage (+ chainage dist))
      )
   (setq count (1+ count))
   )
 )

To get the elevations instead, please adjust these lines:

...
(list (cons 1 (strcat [color=magenta][s]"CH "[/s][/color]"EL "
...
(_text p bearing to height [color=magenta][s]0.0[/s][/color](caddr p))
...
(_text point1 bearing to height [color=magenta][s]chainage[/s][/color](caddr point1))
...

It would be courteous to specify the autor of the tool if wasn't developed by you.

Hi mircea.

Thanks for your help.

Can you help me edit this code again?

What I want is that when the length of the polyline is less than the increment value entered by the user, text must be located on the midddle of the polyline.

Is it possible?

;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:cl (/)
(vl-load-com)
(defun _text (p b o h c)
(entmake
 (append
   '((0 . "MTEXT")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (8 . "C-CTRL_TXT")
     (100 . "AcDbMText")
     )
   (list (cons 10 (polar p (+ b PI) o))
  )
   (list (cons 40 h))
   (list (cons 1 (strcat ""(if (setq ld (nth (strlen (rtos  c 2 0)) '(x   "")))ld "")(rtos c 2 0))));<--:Elevation Value;;;
     (list (cons 50 (+ b (/ pi 2))));<--Rotation angle of text;;
   
     (list '(41 . 0)
     '(90 . 3);<-- Mask
     '(63 . 256);<--Mask
     '(441 . 3935927);<-- Mask 
     '(71 . 5);<--Justification:Middle Center;;
     '(72 . 5)
     (cons 7 (getvar "textstyle"));<--:Current text style;;
     '(210 0.0 0.0 1.0)
     '(73 . 3)
     )
   )
 )
 )
(defun _ang (p1 p2)(+ (angle p1 p2) (/(* 3 PI) 2.0)))
(setq dist (cond ((getdist "increment <400>:"))(400)));<--:Contour Label Increment;;
(setq offset 0)
(setq height 2.5);<--:default text height;;
(setq to 0)
(setq ss (ssget)
count 0
dist dist
offset offset
height height
)
(repeat (sslength ss)
(setq ent (ssname ss count)
  obj (vlax-ename->vla-object ent)
  chainage dist)
  

   (_text p bearing to height (caddr p))
   (while
     (and
(setq point1 (vlax-curve-getPointAtDist obj chainage))
(setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
)
      (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0)))
      (_text point1 bearing to height (caddr point1))
      
      (setq chainage (+ chainage dist))
      )
   (setq count (1+ count))
   )
 )

Please check that bearing variable isn't defined (seems that should contains a rotation).

(_text p [color=red]bearing[/color] to height (caddr p))

I think it is defined here.

(setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0)))

Please check that bearing variable isn't defined (seems that should contains a rotation).

(_text p [color=red]bearing[/color] to height (caddr p))

I think it is defined here.

(setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0)))

Mircea is correct.

your (setq bearing...) is inside while loop ,but (_text p bearing to height (caddr p)) is before while

;;;    (_text p bearing to height (caddr p)) <--- [color="red"]try to remove this line[/color]
   (while
     (and
...
...

thanx for sharing the code

Mircea is correct.

 

your (setq bearing...) is inside while loop ,but (_text p bearing to height (caddr p)) is before while

 

;;;    (_text p bearing to height (caddr p)) <--- [color="red"]try to remove this line[/color]
   (while
     (and
...
...

 

thanx for sharing the code

(_text p bearing to height (caddr p)) If I remove this line, there is no label created on the starting point of the polyline.

see image below

the red drawing is created without removing this line (_text p bearing to height (caddr p))

the green drawing is created without this line (_text p bearing to height (caddr p))

I also want to label the end point of the polyline.

Can you help me with this?

hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post

so i figured out this p,

before while..

  (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj)
   bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
    )
 
   (_text [color="red"]p[/color] bearing to height 0.0)

(while
     (and
...
...

sorry i overlooked

hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post

 

so i figured out this p,

before while..

  (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj)
   bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
    )
 
   (_text [color="red"]p[/color] bearing to height 0.0)

(while
     (and
...
...

sorry i overlooked

i also realised that the second code that i've posted is incomplete.

thanks hanhphuc

hi rrulep, i wonder how did you get it work without (setp P ... ) until i saw your 1st post

 

so i figured out this p,

before while..

  (setq [color="red"]p[/color] (vlax-curve-getstartpoint obj)
   bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
    )
 
   (_text [color="red"]p[/color] bearing to height 0.0)

(while
     (and
...
...

sorry i overlooked

hi hanhphuc

Can you check this code.

Works fine with me but still need your help guys to improve it.

If the length of the polyline is less than the contour interval, it does not create label.

;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cl (/)
(vl-load-com)
(defun _text (p b o h c)
;;;  modified by pbe to add background mask
      (entmake
 (append
   '((0 . "MTEXT")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (8 . "C-CTRL_TXT")
     (100 . "AcDbMText")
     )
   (list (cons 10 (polar p (+ b PI) o))
  )
   (list (cons 40 h))
   (list (cons 1 (strcat ""(if (setq ld (nth (strlen (rtos  c 2 0)) '(x   "")))ld "")(rtos c 2 0))))
     (list (cons 50 (+ b (/ pi 2))))
   
     (list '(41 . 0)
     '(90 . 3);<-- Mask
     '(63 . 256);<--Mask
     '(441 . 3935927);<-- Mask 
     '(71 . 5)
     '(72 . 5)
     (cons 7 (getvar "textstyle"))
     '(210 0.0 0.0 1.0)
     '(73 . 3)
     )
   )
 )
 )
(defun _ang (p1 p2)(+ (angle p1 p2) (/(* 3 PI) 2.0)))
 
(setq dist (cond ((getdist "Contour Label Interval <100>:"))(100)))
 (setq offset 0)
 (setq height 2.5)
 (setq to 0)
 (setq ss (ssget)
count 0
dist dist
offset offset
height height
)
(repeat (sslength ss)
   (setq ent (ssname ss count)
  obj (vlax-ename->vla-object ent)
  chainage dist
   )
(setq p (vlax-curve-getstartpoint obj))
(setq p2 (vlax-curve-getendpoint obj));;;;added by rrulep to label the end points of polyline
(setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))
    
(_text p bearing to height (caddr p));;;;modified by mircea to get the elevation value of polyline
(_text p2 bearing to height (caddr p));;;;added by rrulep to label the end points of polyline
   (while
     (and
(setq point1 (vlax-curve-getPointAtDist obj chainage))
(setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
)
      (setq bearing (+ (angle point1 point2) (/(* 3 PI )2.0)))
      (_text point1 bearing to height (caddr point1));;;;modified by mircea to get the elevation value of polyline
      
      (setq chainage (+ chainage dist))
      )
   (setq count (1+ count))
   )
 )

If the length of the polyline is less than the contour interval, it does not create label.

What do you want the program to do instead? terminate the program? or do something else?

What do you want the program to do instead? terminate the program? or do something else?

i want to label the midpoint of the polyline

will that be text at start/mid/end for *LINES whose length is less than interval value?

OR Start and end would be enough?

i want to label the midpoint of the polyline

The code should be like this.

If the interval is equal or greater than the length of polyline, it should label only the start point, midpoint, and endpoint of the polyline. (drawing on right side)

If the interval is less than the length of the polyline, it should label the polyline like on the drawing (left side).

Forgive me for coming in late for the party, but is the routine exclusively for straight segments?

Forgive me for coming in late for the party, but is the routine exclusively for straight segments?

no pbe

i just use straight line for demonstration.

Apologies for running out on you rrulep.

(defun c:cl (/ _text _ang offset height	to count ss ent	chainage ln _mp
     bearing p p2 point1)
 (vl-load-com)
 (defun _text (p b o h c)
;;;  modified by pbe to add background mask
   (entmake
     (append
'((0 . "MTEXT")
  (100 . "AcDbEntity")
  (67 . 0)
  (410 . "Model")
  (8 . "C-CTRL_TXT")
  (100 . "AcDbMText")
 )
(list (cons 10 (polar p (+ b PI) o))
)
(list (cons 40 h))
(list
  (cons
    1
    (strcat ""
	    (if	(setq ld (nth (strlen (rtos c 2 0)) '(x "")))
	      ld
	      ""
	    )
	    (rtos c 2 0)
    )
  )
)
(list (cons 50 (+ b (/ pi 2))))

(list '(41 . 0)
      '(90 . 3)			;<-- Mask
      '(63 . 256)		;<--Mask
      '(441 . 3935927)		;<-- Mask 
      '(71 . 5)
      '(72 . 5)
      (cons 7 (getvar "textstyle"))
      '(210 0.0 0.0 1.0)
      '(73 . 3)
)
     )
   )
 )
;;;		Modified by pBe		;;;
 (defun _ang (en d pt)
   (+ (angle '(0.0 0.0 0.0)
      (vlax-curve-getfirstderiv
	en
	(vlax-curve-getparamatpoint en pt)
      )
      )
      (* pi 1.5)
   )
 )

;;;		Modified by pBe		;;;

 (setq	dist (cond ((getdist "Contour Label Interval <100>:"))
	   (100)
     )
 )
 (setq offset 0)
 (setq height 2.5)
 (setq to 0)
 (setq	ss    (ssget)
count 0
 )
 (repeat (sslength ss)
   (setq ent	   (ssname ss count)
  obj	   (vlax-ename->vla-object ent)
  chainage dist
   )
   (setq p (vlax-curve-getstartpoint ent))
   (setq p2 (vlax-curve-getendpoint ent))

;;;	Additional option / re-arrange sequence		;;;

;;;;modified by mircea to get the elevation value of polyline    
   (_text p (_ang ent chainage p) to height (caddr p))

;;; 	Start/Mid/End mode iI Length is less than or equal twice the value of dist variable	;;;
   (if	(<= (setq ln (vlax-curve-getdistatparam
	       ent
	       (vlax-curve-getendparam ent)
	     )
    )
    (* 2 dist)
)
     (_text (setq _mp (vlax-curve-getpointatdist ent (* ln 0.5)))
     (_ang ent (* ln 0.5) _mp)
     to
     height
     (caddr _mp)
     )
     (while
(setq point1 (vlax-curve-getPointAtDist obj chainage))
 (setq bearing (_ang ent (+ chainage dist) point1))
 (_text point1 bearing to height (caddr point1))
 (setq chainage (+ chainage dist))
     )
   )
   (_text p2 (_ang ent chainage p2) to height (caddr p2))
   (setq count (1+ count))
 )
 (princ)
)

hi hanhphuc

Can you check this code.

Works fine with me but still need your help guys to improve it.

If the length of the polyline is less than the contour interval, it does not create label.

i just add a line in red, not fully tested

;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[color="red"](setq *dist* 100.) ; default[/color]
(defun c:cl (/ dist height to ss count height ent obj chainage p p2 len obj bearing); <-- localize 
 (vl-load-com)
 (defun _text (p b o h c)
;;;  modified by pbe to add background mask
   (entmake (append '((0 . "MTEXT")
	       (100 . "AcDbEntity")
	       (67 . 0)
	       (410 . "Model")
	       (8 . "C-CTRL_TXT")
	       (100 . "AcDbMText")
	       )
	     (list (cons 10 (polar p (+ b PI) o)))
	     (list (cons 40 h))
	     (list (cons 1
			 (strcat ""
				 (if (setq ld (nth (strlen (rtos c 2 0)) '(x "")))
				   ld
				   ""
				   ) ;_ end of if
				 (rtos c 2 0)
				 ) ;_ end of strcat
			 ) ;_ end of cons
		   ) ;_ end of list
	     (list (cons 50 (+ b (/ pi 2))))
	     (list '(41 . 0)
		   '(90 . 3) ;<-- Mask
		   '(63 . 256) ;<--Mask
		   '(441 . 3935927) ;<-- Mask 
		   '(71 . 5)
		   '(72 . 5)
		   (cons 7 (getvar "textstyle"))
		   '(210 0.0 0.0 1.0)
		   '(73 . 3)
		   ) ;_ end of list
	     ) ;_ end of append
     ) ;_ end of entmake
   ) ;_ end of defun
 (defun _ang (p1 p2) (+ (angle p1 p2) (/ (* 3 PI) 2.0)))
 
;;;  (setq	*dist* (cond ((getdist "Contour Label Interval <100>:"))
;;;		   (100)
;;;		   ) ;_ end of cond
;;;	) ;_ end of setq
 
 [color="blue"];;modified by hanhphuc *dist* variable sets to global, just [Enter] for default[/color]
[color="red"]  (initget 6) ; prevent entering negative & zero
 (setq	dist (getdist	(strcat	"Contour Label Interval <"
			(if (and *dist* (numberp *dist*))
			  (rtos *dist*)
			  "100"
			  ) ;_ end of if
			"> : "
			) ;_ end of strcat
		) ;_ end of getdist
*dist* (if (not dist)
	 *dist*
	dist
	 ) ;_ end of if
) ;_ end of setq[/color]
 
;;;  (setq offset 0) 
 (setq	height 2.5
to 0
ss (ssget)
count 0
;;;	dist   dist
;;;	offset offset
;;;	height height
) ;_ end of setq
 (if ss
   (repeat (sslength ss)
     (setq ent	     (ssname ss count)
    obj	     (vlax-ename->vla-object ent)
    chainage *dist*
    ) ;_ end of setq
     (setq p (vlax-curve-getstartpoint obj))
     (setq p2 (vlax-curve-getendpoint obj))
;;;;added by rrulep to label the end points of polyline

[color="blue"];;added by hanhphuc if interval > length, (if.. progn..)[/color]
[color="red"]      (setq len (vlax-curve-getDistAtPoint obj p2))
     (if (>= *dist* len)
(mapcar	''((x)
	   (_text
	    x
	    (_ang x (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj p) 0.001)))
	    to
	    (* height 10. (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
	    (caddr x)
	    )
	   )
	(list p (vlax-curve-getPointAtDist obj (/ len 2)) p2)
	) ;_ end of mapcar[/color]

[color="red"](progn [/color](setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))
       (_text p bearing to height (caddr p))
;;;;modified by mircea to get the elevation value of polyline
       (_text p2 bearing to height (caddr p))
;;;;added by rrulep to label the end points of polyline
       (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage))
		   (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
		   ) ;_ end of and
	 (setq bearing (+ (angle point1 point2) (/ (* 3 PI) 2.0)))
	 (_text point1 bearing to height (caddr point1))
;;;;modified by mircea to get the elevation value of polyline
	 (setq chainage (+ chainage *dist*))
	 ) ;_ end of while
       (setq count (1+ count))
[color="red"]       ) ;_ end of progn
) ;_ end of if[/color]
     ) ;_ end of repeat
   ) ;_ end of if
 ) ;_ end of defun

Apologies for running out on you rrulep.

 

(defun c:cl (/ _text _ang offset height	to count ss ent	chainage ln _mp
     bearing p p2 point1)
 (vl-load-com)
 (defun _text (p b o h c)
;;;  modified by pbe to add background mask
   (entmake
     (append
'((0 . "MTEXT")
  (100 . "AcDbEntity")
  (67 . 0)
  (410 . "Model")
  (8 . "C-CTRL_TXT")
  (100 . "AcDbMText")
 )
(list (cons 10 (polar p (+ b PI) o))
)
(list (cons 40 h))
(list
  (cons
    1
    (strcat ""
	    (if	(setq ld (nth (strlen (rtos c 2 0)) '(x "")))
	      ld
	      ""
	    )
	    (rtos c 2 0)
    )
  )
)
(list (cons 50 (+ b (/ pi 2))))

(list '(41 . 0)
      '(90 . 3)			;<-- Mask
      '(63 . 256)		;<--Mask
      '(441 . 3935927)		;<-- Mask 
      '(71 . 5)
      '(72 . 5)
      (cons 7 (getvar "textstyle"))
      '(210 0.0 0.0 1.0)
      '(73 . 3)
)
     )
   )
 )
;;;		Modified by pBe		;;;
 (defun _ang (en d pt)
   (+ (angle '(0.0 0.0 0.0)
      (vlax-curve-getfirstderiv
	en
	(vlax-curve-getparamatpoint en pt)
      )
      )
      (* pi 1.5)
   )
 )

;;;		Modified by pBe		;;;

 (setq	dist (cond ((getdist "Contour Label Interval <100>:"))
	   (100)
     )
 )
 (setq offset 0)
 (setq height 2.5)
 (setq to 0)
 (setq	ss    (ssget)
count 0
 )
 (repeat (sslength ss)
   (setq ent	   (ssname ss count)
  obj	   (vlax-ename->vla-object ent)
  chainage dist
   )
   (setq p (vlax-curve-getstartpoint ent))
   (setq p2 (vlax-curve-getendpoint ent))

;;;	Additional option / re-arrange sequence		;;;

;;;;modified by mircea to get the elevation value of polyline    
   (_text p (_ang ent chainage p) to height (caddr p))

;;; 	Start/Mid/End mode iI Length is less than or equal twice the value of dist variable	;;;
   (if	(<= (setq ln (vlax-curve-getdistatparam
	       ent
	       (vlax-curve-getendparam ent)
	     )
    )
    (* 2 dist)
)
     (_text (setq _mp (vlax-curve-getpointatdist ent (* ln 0.5)))
     (_ang ent (* ln 0.5) _mp)
     to
     height
     (caddr _mp)
     )
     (while
(setq point1 (vlax-curve-getPointAtDist obj chainage))
 (setq bearing (_ang ent (+ chainage dist) point1))
 (_text point1 bearing to height (caddr point1))
 (setq chainage (+ chainage dist))
     )
   )
   (_text p2 (_ang ent chainage p2) to height (caddr p2))
   (setq count (1+ count))
 )
 (princ)
)

Thanks pbe

It works perfectly:D

waiting for your reply is worthit

i just add a line in red, not fully tested

;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[color="red"](setq *dist* 100.) ; default[/color]
(defun c:cl (/ dist height to ss count height ent obj chainage p p2 len obj bearing); <-- localize 
 (vl-load-com)
 (defun _text (p b o h c)
;;;  modified by pbe to add background mask
   (entmake (append '((0 . "MTEXT")
	       (100 . "AcDbEntity")
	       (67 . 0)
	       (410 . "Model")
	       (8 . "C-CTRL_TXT")
	       (100 . "AcDbMText")
	       )
	     (list (cons 10 (polar p (+ b PI) o)))
	     (list (cons 40 h))
	     (list (cons 1
			 (strcat ""
				 (if (setq ld (nth (strlen (rtos c 2 0)) '(x "")))
				   ld
				   ""
				   ) ;_ end of if
				 (rtos c 2 0)
				 ) ;_ end of strcat
			 ) ;_ end of cons
		   ) ;_ end of list
	     (list (cons 50 (+ b (/ pi 2))))
	     (list '(41 . 0)
		   '(90 . 3) ;<-- Mask
		   '(63 . 256) ;<--Mask
		   '(441 . 3935927) ;<-- Mask 
		   '(71 . 5)
		   '(72 . 5)
		   (cons 7 (getvar "textstyle"))
		   '(210 0.0 0.0 1.0)
		   '(73 . 3)
		   ) ;_ end of list
	     ) ;_ end of append
     ) ;_ end of entmake
   ) ;_ end of defun
 (defun _ang (p1 p2) (+ (angle p1 p2) (/ (* 3 PI) 2.0)))
 
;;;  (setq	*dist* (cond ((getdist "Contour Label Interval <100>:"))
;;;		   (100)
;;;		   ) ;_ end of cond
;;;	) ;_ end of setq
 
 [color="blue"];;modified by hanhphuc *dist* variable sets to global, just [Enter] for default[/color]
[color="red"]  (initget 6) ; prevent entering negative & zero
 (setq	dist (getdist	(strcat	"Contour Label Interval <"
			(if (and *dist* (numberp *dist*))
			  (rtos *dist*)
			  "100"
			  ) ;_ end of if
			"> : "
			) ;_ end of strcat
		) ;_ end of getdist
*dist* (if (not dist)
	 *dist*
	dist
	 ) ;_ end of if
) ;_ end of setq[/color]
 
;;;  (setq offset 0) 
 (setq	height 2.5
to 0
ss (ssget)
count 0
;;;	dist   dist
;;;	offset offset
;;;	height height
) ;_ end of setq
 (if ss
   (repeat (sslength ss)
     (setq ent	     (ssname ss count)
    obj	     (vlax-ename->vla-object ent)
    chainage *dist*
    ) ;_ end of setq
     (setq p (vlax-curve-getstartpoint obj))
     (setq p2 (vlax-curve-getendpoint obj))
;;;;added by rrulep to label the end points of polyline

[color="blue"];;added by hanhphuc if interval > length, (if.. progn..)[/color]
[color="red"]      (setq len (vlax-curve-getDistAtPoint obj p2))
     (if (>= *dist* len)
(mapcar	''((x)
	   (_text
	    x
	    (_ang x (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj p) 0.001)))
	    to
	    (* height 10. (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
	    (caddr x)
	    )
	   )
	(list p (vlax-curve-getPointAtDist obj (/ len 2)) p2)
	) ;_ end of mapcar[/color]

[color="red"](progn [/color](setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))
       (_text p bearing to height (caddr p))
;;;;modified by mircea to get the elevation value of polyline
       (_text p2 bearing to height (caddr p))
;;;;added by rrulep to label the end points of polyline
       (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage))
		   (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
		   ) ;_ end of and
	 (setq bearing (+ (angle point1 point2) (/ (* 3 PI) 2.0)))
	 (_text point1 bearing to height (caddr point1))
;;;;modified by mircea to get the elevation value of polyline
	 (setq chainage (+ chainage *dist*))
	 ) ;_ end of while
       (setq count (1+ count))
[color="red"]       ) ;_ end of progn
) ;_ end of if[/color]
     ) ;_ end of repeat
   ) ;_ end of if
 ) ;_ end of defun

hi hanhphuc

it also works

thanks for your help guys