;;; Draw Road Sections Labels
;;; Created by Dave Corrall 12-Nov-2001
;;; Slightly modified by Igal Averbuh 2017

;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" "Sections 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" "Sections") nil)
(command "layer" "m" "Sections" "c" "7" "" "")
(command "layer" "s" "Sections" "")
)
(setq step(getreal "\nSection Interval: ")
svprefix(getstring "\nPrefix (Enter for None): ")
scale(getdist "\nScale by two points on screen: ")
svval 0)
(setq nam (car (entsel "\nSelect LWPolyline for Section Labeling: ")))
(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)
(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)))
(command "-insert" "sv" 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)))
(command "-insert" "sv" 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 ( 180 deg
(if (< bulge 0) ; if clockwise
(setq dtoc (- a thet))
(setq dtoc (+ a thet))
)
(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)))
(command "-insert" "sv" 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:ch ()
(princ "Place SV Block to support path directory")
(intro)
(if(= qr "Q")
(progn
(setq qr nil)
(thanku)
)
(progn
(chainage)
(thanku)
)
)
)

Advertisements