woodman78 Posted December 5, 2014 Posted December 5, 2014 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 Quote
BIGAL Posted December 5, 2014 Posted December 5, 2014 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. Quote
woodman78 Posted December 8, 2014 Author Posted December 8, 2014 Thanks for your help Bigal. I got it sorted. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.