Place block at start of line using Measure command

Hi all,

I have modified this lisp by Dave Corrall to create chainages as per our requirements. I am wondering how to add the "Chainage_Tick" at the vert start of the line.

Can anyone help?

;draw chainages
;by Dave Corrall   12-Nov-2001

;degrees>radians
(defun dtr (a)
 (* pi (/ a 180.0))
 )
;radians>degrees
(defun rtd (a)
 (* 180.0(/ a pi))
 )

(defun intro ()
 (setq dialog-state 999)
 (setq dialog_pos (list -1 -1))
 (setq dcl_id (load_dialog "intro.dcl"))
 (princ "\nDialog Box:")
 (while (< 2 dialog-state)
   (new_dialog "intro" dcl_id "" dialog_pos)
   (set_tile "lname" "Chainages on Polyline")
   (setq x (dimx_tile "DC")
  y (dimy_tile "DC"))
   (fill_image 0 0 x y -15)
   (start_image "DC")
   (slide_image 0 0 x y "dc_logo")
   (end_image)
   (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(quit_routine)")
   (action_tile "about" "(setq userclick1 t)(open_about)")
   (setq dialog-state (start_dialog))
   (if (= dialog-state 1)
     (princ)
;      (princ "\nDialog Box: ")
     )
   )
 (unload_dialog dcl_id)
;  (princ "\nDialog Box: ")
)

; tell about routine

(defun open_about ()
;  (done_dialog)
 (startapp "notepad.exe" "chains.txt")
;  (setq userclick1 nil)
 )

(defun quit_routine ()
 (setq qr "Q")
 )


(defun chainage ()
 (setq oreq(getvar"attreq")odia(getvar"attdia"))
 (setq oldlayer(getvar "clayer"))
 (setvar "attreq" 1)
 (setvar "attdia" 0)
 (setvar "osmode" 1024)
 (command "ucs" "")
 (setq r 0.0)
 (setq seg 0.0)
 (if (= (tblsearch "LAYER" "CCC_LAYOUT_Chainages") nil)
     (command "layer" "m" "CCC_LAYOUT_Chainages" "c" "7" "" "")
     (command "layer" "s" "CCC_LAYOUT_Chainages" "")
   )
 (setq step(getreal "\nSet interval to display Chainage text: ")
svprefix "Ch"
svsuffix "m"
scale "1"
svval 0)
 (setq nam (car (entsel "\nSelect Polyline: ")))
(command "_change" nam ""  "p" "Layer" "CCC_LAYOUT_Chainages" "color" "Bylayer" "")
 (setq ent (entget nam))
(command "_.insert" "Chainage_Tick" nil)
(command "measure" nam "b" "Chainage_Tick" "y" "10" "")
 (if (not (equal (cdr (assoc 0 ent)) "LWPOLYLINE"))
     (prompt "\nEntity not a polyline...")
     (progn
(setq nv (cdr(assoc 90 ent)))
(setq ent1 (member(assoc 10 ent)ent))
  (setq ent2(cdr ent1))
  (setq ent2(member(assoc 10 ent2)ent2))
(while (/= ent2 nil)
  (if (/= ent2 nil)

                  (progn

;  IF THE VERTEX PRECEDES A STRAIGHT LINE

                     (if (equal (cdr (assoc 42 ent1)) 0.0)
                     (progn
                        (setq v1(cdr(assoc 10 ent1))
		       v2(cdr(assoc 10 ent2))
		       a(angle v1 v2)
		       d(distance v1 v2)
		       p1(polar v1 a (- step r))
		       d1(distance p1 v2)
		       )
		(if(< seg 1)
		  (progn
		(setq value(strcat svprefix (rtos svval 2 0) svsuffix ))
		(command "-insert" "Chainage_Text" v1 scale scale (rtd a) value)
		)
		  )
		(if(<(+ d r) step)
		  (progn
		    (setq r (+ d r))
		    )
		  (progn
		    (setq num(1+(fix(/ d1 step))))
		    (setq cnt 0)
		    (repeat num
		      (progn
			(setq pt(polar p1 a (* cnt step)))
			(setq svval(+ svval step)
			      value(strcat svprefix (rtos svval 2 0) svsuffix ))
			(command "-insert" "Chainage_Text" pt scale scale (rtd a) value)
			(setq cnt (1+ cnt))
			)
		      )
		    (setq r(rem d1 step))
		    )
		  )
; set new values for variables			
		(setq ent1 ent2)
		(setq ent2(cdr ent2))
		(setq ent2(member(assoc 10 ent2)ent2))
		(setq seg(1+ seg))
		);end progn for straight section
;if the vertex preceds an arc
		(progn
		  (setq v1(cdr(assoc 10 ent1))
			v2(cdr(assoc 10 ent2))
			bulge(cdr(assoc 42 ent1))
			)
		  (setq a(angle v1 v2)
			d(distance v1 v2)
			radi(abs(/ d(* 2.0(sin(*(atan bulge) 2)))))
			)
		  (setq hfd(/ d 2.0)
			thet(atan(/(sqrt(-(* radi radi)(* hfd hfd)))hfd))
			)
		  (if (< (abs bulge) 1)         ; if > 180 deg
                               (if (< bulge 0)             ; if clockwise
                                 (setq dtoc (- a thet))
                                 (setq dtoc (+ a thet))
                               )
                              (if (< bulge 0)
                                (setq dtoc (+ a thet))
                                (setq dtoc (- a thet))
                              )
                         )
                            (setq p1 v1)
                            (setq p2 v2)
                            (setq pc (polar p1 dtoc radi))
                            (setq beg (angle pc p1))
                            (setq end (angle pc p2))
; CALCULATE LENGTH OF ARC


                            (setq swept (abs (- beg end) ))
                            (setq len (abs (* (- beg end) radi)))
                            (if (and (< (abs bulge) 1) (> swept pi ))
                                (setq len (- (* 2 pi radi) len))
                            )


                         (if (< (+ len r) step)
                         (progn
                             (setq r (+ len r))
                         )
                         (progn
                            (if (and (> (abs bulge) 1) (< swept pi ))
                                (setq len (- (* 2 pi radi) len))
                            )
                            (setq beta (- step r))
                            (setq len1 (- len beta))
                            (if (> bulge 0)
                                (setq beg (+ beg (/ beta radi) ) )
                                (setq beg (- beg (/ beta radi) ) )
                            )
                            (setq num (1+ (fix (/ len1 step))))
                            (setq astep (/ step radi ))
                            (setq cnt 0)
                            (repeat num
                              (progn
                                 (if (> bulge 0)
                                    (setq ai (+ beg (* cnt astep))
				   ab(+ ai (dtr 90)))
                                    (setq ai (- beg (* cnt astep))
				   ab(- ai (dtr 90)))
                                 )
                                 (setq pt (polar pc ai radi))
			(setq svval(+ svval step)
			      value(strcat svprefix (rtos svval 2 0) svsuffix ))				 
			(command "-insert" "Chainage_Text" pt scale scale (rtd ab) value)
			(setq cnt (1+ cnt))
			 )
		       )
		    (setq r(rem len1 step))
		    (if(equal r 0.0)(setq r step))
		    )
		    )
; set new values for variables			
		(setq ent1 ent2)
		(setq ent2(cdr ent2))
		(setq ent2(member(assoc 10 ent2)ent2))
		);end progn for arc section			  
		);end if check straight or arc
	     );end progn
    );end if /= ent2 nil
  );end while /= ent2 nil
)
   )
 ;reset variables
 (setvar "attreq" oreq)
 (setvar "attdia" odia)
 (command "layer" "s" oldlayer "")
 (command "ucs" "p")
 )
(defun thanku()
 (setq dialog-state 999)
 (setq dialog_pos (list -1 -1))
 (setq dcl_id (load_dialog "thanks.dcl"))
 (while (< 2 dialog-state)
   (new_dialog "thanks" dcl_id "" dialog_pos)
   (set_tile "lname" "Chainage Routine")
   (setq x (dimx_tile "DC")
  y (dimy_tile "DC"))
   (fill_image 0 0 x y -15)
   (start_image "DC")
   (slide_image 10 10 x y "dc_logo")
   (end_image)
   (setq dialog-state (start_dialog))
   (if (= dialog-state 1)
     (princ)
     )
   )
 (unload_dialog dcl_id)
 (princ)
 )

;command routine
(defun c:chains ()
 (intro)
 (if(= qr "Q")
   (progn
     (setq qr nil)
     (thanku)
     )
   (progn
     (chainage)
     (thanku)
     )
   )
 )

;PI's on pipelines no radiused bends

(defun c:bends ()
 (if (= (tblsearch "LAYER" "Bend_numbers") nil)
     (command "layer" "m" "Bend_numbers" "c" "1" "" "")
     (command "layer" "s" "Bend_numbers" "")
   )
 (setq bend 1.0)
 (setq nam (car (entsel "\nSelect Polyline: ")))
 (setq ent (entget nam))
 (if (not (equal (cdr (assoc 0 ent)) "LWPOLYLINE"))
     (prompt "\nEntity not a polyline...")
     (progn
(setq nv (cdr(assoc 90 ent)))
(setq ent1 (member(assoc 10 ent)ent))
  (setq ent2(cdr ent1))
  (setq ent2(member(assoc 10 ent2)ent2))
(while (/= ent2 nil)
                   (setq v1(cdr(assoc 10 ent1))
                  v2(cdr(assoc 10 ent2))
	          a(angle v1 v2)
		  )
	    (command "text" "c" (polar v1 (+ (dtr 90) a) (* scale 1.25)) (* scale 3.5) (rtd a) (rtos bend 2 0))
  (setq bend(1+ bend))
  (setq ent1 ent2)
  (setq ent2(cdr ent2))
  (setq ent2(member(assoc 10 ent2)ent2))
  )
)
   )
 )

Chainage_Text.dwg

Chainage_Tick.dwg

Need to add a last routine that looks at the start angle if a line+90 and if segment is an arc looks at endpt-cenpt then do again for end segment. You have ;end if check straight or arc defun now.

Thanks for your help Bigal. I got it sorted.