Krztoff Posted February 12, 2009 Share Posted February 12, 2009 Hello, everyone! I am developing a traffic organisation plan for a highway and I was wondering if anyone could help me out with any tips or LISPs that could aid me in this task. The Problem is as follows: 1. I would like to know of a way to place text on the midpoint of a polyline with a specific offset.The text should be aligned with the polyline. I would like to be able to modify the text afterwards as well. 2. If this is possible, it would really make my life a lot easier - I would like to have a field or something that automatically shows the length of the line placed in brackets behind the editable text. For example I have traffic lane markings with a specific number, like 920, then i would like to add the text "920" to a polyline so it automatically fits to the midpoint and aligns with the polyline and in brackets behind the "920" there would be a field with the line length, like that 920 (137 m). I use metric units and my drawing units are set to meters so a letter "m" after the length field would also be very nice. I use Autodesk Civil 3d 2008. Thank you for your time! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 12, 2009 Share Posted February 12, 2009 I can to test this just in A2008 Hope it will works for you ; +-------+---------+---------+-----flb.lsp----+---------+--------+--------+ ; (vl-load-com) (defun C:FLB (/ acsp adoc ang der ent midp mtx oid pline pref txp txt) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (if (setq ent (entsel "\nSelect polyline >>")) (progn (setq oid (vla-get-objectid (setq pline (vlax-ename->vla-object (car ent)))) ) (setq midp (vlax-curve-getclosestpointto pline (vlax-curve-getpointatdist pline (/ (vla-get-length pline) 2))) ) (vlax-invoke acsp 'AddCircle midp 2.0) (setq der (vlax-curve-getfirstderiv pline (vlax-curve-getparamatpoint pline midp))) (if (zerop (cadr der)) (setq ang (/ pi 2)) (setq ang (- pi (atan (/ (car der) (cadr der))))) ) (initget 6) (setq hgt (getdist "\nEnter text height <5.0>: ")) (if (not hgt)(setq hgt 5.)) (setq txp (polar midp ang hgt)) (setq pref (getstring T "\nEnter label prefix <920>: ")) (if (eq "" pref)(setq pref "920")) (setq pref (strcat pref " (")) (setq txt (strcat pref "%<\\AcObjProp Object(%<\\_ObjId " (itoa oid) ">%).Length \\f \"%lu2%pr3\">% m)") ) (setq mtx (vlax-invoke acsp 'AddMText txp 0.0 txt) ) (setq ang (- ang (/ pi 2))) (setq ang (cond ((> pi ang (/ pi 2))(- pi ang)) ((> (* pi 1.5) ang pi)(- ang pi)) ((> (* pi 2) ang (* pi 1.5))(- (* pi 2) ang)) (T ang)) ) (vlax-put mtx 'AttachmentPoint 5 ) (vlax-put mtx 'InsertionPoint txp) (vlax-put mtx 'Rotation ang) (vla-update mtx) ) ) (princ) ) (princ "\n Start command with FLB ...") (princ) ; +---------+---------+---------+---------+---------+---------+---------+ ; ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 13, 2009 Author Share Posted February 13, 2009 Woow! thank you for the fast reply! It is amazing, thank you very much, this is a big step forward for me, however is it possible to modify the lisp so the text offset from the line could be set by the user, now it offsets the text a bit too far, it's not hard to place it closer by hand, but maybe that could also be automated, and the field precision maybe could be limited to 2 digits after the coma, now it is a bit too precise It is amazing how LISP's can make one's life easier, thank you so much for this solution!!! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 Try this slightly edited version instead I was changed offset distance and precision to 2 digits ; +-------+---------+---------+-----flb.lsp----+---------+--------+--------+ ; (vl-load-com) (defun C:FLB (/ acsp adoc ang der ent gap midp mtx oid pline pref txp txt) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (if (setq ent (entsel "\nSelect polyline >>")) (progn (setq oid (vla-get-objectid (setq pline (vlax-ename->vla-object (car ent)))) ) (setq midp (vlax-curve-getclosestpointto pline (vlax-curve-getpointatdist pline (/ (vla-get-length pline) 2))) ) (vlax-invoke acsp 'AddCircle midp 2.0) (setq der (vlax-curve-getfirstderiv pline (vlax-curve-getparamatpoint pline midp))) (if (zerop (cadr der)) (setq ang (/ pi 2)) (setq ang (- pi (atan (/ (car der) (cadr der))))) ) (initget 6) (setq hgt (getdist "\nEnter text height <5.0>: ")) (if (not hgt)(setq hgt 5.)) (initget 6) (setq gap (getdist "\nEnter distance of the text offset <2.5>: ")) (if (not gap)(setq gap 2.5)) (setq txp (polar midp ang gap)) (setq pref (getstring T "\nEnter label prefix <920>: ")) (if (eq "" pref)(setq pref "920")) (setq pref (strcat pref " (")) (setq txt (strcat pref "%<\\AcObjProp Object(%<\\_ObjId " (itoa oid) ">%).Length \\f \"%lu2%pr2\">% m)");--> number of decimals = 2 ) (setq mtx (vlax-invoke acsp 'AddMText txp 0.0 txt) ) (setq ang (- ang (/ pi 2))) (setq ang (cond ((> pi ang (/ pi 2))(- pi ang)) ((> (* pi 1.5) ang pi)(- ang pi)) ((> (* pi 2) ang (* pi 1.5))(- (* pi 2) ang)) (T ang)) ) (vlax-put mtx 'AttachmentPoint 5 ) (vlax-put mtx 'InsertionPoint txp) (vlax-put mtx 'Height hgt) (vlax-put mtx 'Rotation ang) (vla-update mtx) ) ) (princ) ) (princ "\n Start command with FLB ...") (princ) ; +---------+---------+---------+---------+---------+---------+---------+ ; Btw, welcome on board ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 13, 2009 Author Share Posted February 13, 2009 Thank you, this is perfect, however i did some more testing and there is something wrong if the polyline goes straight up to the North or to the North-West, then the alignment doesn't work, is it a Civil 3d glitch or does it happen on other platforms as well and can there be something done about that? Thank you for the warm welcome! I recently started working at a road design company and needed to find some ways of optimizing my job efficiency! This forum has helped a lot. Keep up the fantastic work! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 there is something wrong if the polyline goes straight up to the North or to the North-West, then the alignment doesn't work! Ok I will to test it with these directions too but later Now I'm extremely busy, sorry ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 13, 2009 Author Share Posted February 13, 2009 Ok, no problem, it's not that urgent, thanks! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 Here is edited version You can select multiple just enter prefixes in command line I think this must be more handly ; +-------+---------+---------+-----flb.lsp (v.3)----+---------+--------+--------+ ; (vl-load-com) (defun C:FLB (/ acsp adoc ang der ent gap midp mtx oid pline pref txp txt) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (initget 6) (setq hgt (getdist "\nEnter text height <5.0>: ")) (if (not hgt)(setq hgt 5.)) (initget 6) (setq gap (getdist (strcat "\nEnter offset distance for text <" (rtos (* hgt 2) 2 1) ">: "))) (if (not gap)(setq gap (* hgt 2))) (while (setq ent (entsel "\nSelect polyline (or press Enter to Exit) >>")) (setq oid (vla-get-objectid (setq pline (vlax-ename->vla-object (car ent)))) ) (setq midp (vlax-curve-getclosestpointto pline (vlax-curve-getpointatdist pline (/ (vla-get-length pline) 2))) ) ;;;(vlax-invoke acsp 'AddCircle midp 2.0) (setq der (vlax-curve-getfirstderiv pline (vlax-curve-getparamatpoint pline midp))) (if (zerop (cadr der)) (setq ang (/ pi 2)) (setq ang (- pi (atan (/ (car der) (cadr der))))) ) (if (> pi ang (/ pi 2)) (setq ang (+ ang pi))) (if (equal (rem ang (/ pi 2)) 0 0.001) (setq txp (polar midp ang (* gap 1.75))) (setq txp (polar midp (+ ang pi) (* gap 2.))) ) (setq pref (getstring T "\nEnter label prefix <920>: ")) (if (eq "" pref)(setq pref "920")) (setq pref (strcat pref " (")) (setq txt (strcat pref "%<\\AcObjProp Object(%<\\_ObjId " (itoa oid) ">%).Length \\f \"%lu2%pr2\">% m)") ) (setq mtx (vlax-invoke acsp 'AddMText txp 0.0 txt) ) (setq ang (- ang (/ pi 2))) (setq ang (cond ((> pi ang (/ pi 2))(+ pi ang)) ((> (* pi 1.5) ang pi)(- ang pi)) ((> (* pi 2) ang (* pi 1.5))(- (* pi 2) ang)) (T ang)) ) (vlax-put mtx 'Height hgt) (vlax-put mtx 'AttachmentPoint 5) (vlax-put mtx 'InsertionPoint txp) (vlax-put mtx 'Rotation ang) (vla-update mtx) ) (princ) ) (princ "\n Start command with FLB ...") (princ) ; +---------+---------+---------+---------+---------+---------+---------+ ; ~'J'~ Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 Let me know how it's worked I haven't time to test it at the moment ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 13, 2009 Author Share Posted February 13, 2009 Hello, I tested it at home on Civil 3d 2009 and it works like a charm! The only thing is that there are 3 digits behind the coma again, if that could be reduced back to 2 then the LISP seems to be flawless And the multiple selection ability is simply ingenious, thank you! This is more than I actually hoped for! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 if that could be reduced back to 2 then the LISP seems to be flawless Okay, I have fixed it in the code above Now it will write 2 decimals as you wanted Happy computing ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 13, 2009 Author Share Posted February 13, 2009 You are a life saver! Thanks, your effort is much appreciated, hopefully one day I will get the hang of writing my own LISP routines and help others as well. At this point LISP's seem to me like some far out alien language. Cheers! Quote Link to comment Share on other sites More sharing options...
fixo Posted February 13, 2009 Share Posted February 13, 2009 Thank you, your words are like the honey on my soul I like to help others when I have a time Best regards, ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 16, 2009 Author Share Posted February 16, 2009 Hi, one more thing i just recently noticed, the text height function doesn't seem to work for me (it always sets the text height to 0.2), it's not a big problem to use the autocad built in function "select similar" and quickly change the height of all the symbols, but if you will happen to have some spare time it would be very nice to help solve this issue, otherwise this function is pointless to have in the LISP , however that is not an urgent matter, and I have already boosted the work efficiency tremendously with the help of this LISP so this issue can wait a bit. Quote Link to comment Share on other sites More sharing options...
fixo Posted February 16, 2009 Share Posted February 16, 2009 Hi, one more thing i just recently noticed, the text height function doesn't seem to work for me (it always sets the text height to 0.2), it's not a big problem to use the autocad built in function "select similar" and quickly change the height of all the symbols, but if you will happen to have some spare time it would be very nice to help solve this issue, otherwise this function is pointless to have in the LISP , however that is not an urgent matter, and I have already boosted the work efficiency tremendously with the help of this LISP so this issue can wait a bit. Sorry, my bad I changed the code in post #8 Hope it will works good now Cheers ~'J'~ Quote Link to comment Share on other sites More sharing options...
Krztoff Posted February 17, 2009 Author Share Posted February 17, 2009 Yes, it is fully functional now (at least so it seems for now), thank you for all your time and effort Quote Link to comment Share on other sites More sharing options...
fixo Posted February 17, 2009 Share Posted February 17, 2009 You're quite welcome Keep programming ~'J'~ Quote Link to comment Share on other sites More sharing options...
Stryder Posted March 31, 2009 Share Posted March 31, 2009 I have been trying to modify the flb.lsp with no success. I am not very good at using the lsp code anyway and continue to get a syntax error everytime I make a change. I would like the text height for the inserted text to always be .06 x the dimscale and the offset to be the same - .06 x the dimscale. I would also like the format to be L=###.## I am sure these changes would be simple for anyone that is good with lisp files and any help would be greatly appreciated. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 31, 2009 Share Posted March 31, 2009 Untested (doesn't seem to work on '04), but give this a go ; +-------+---------+---------+-----flb.lsp (v.3)----+---------+--------+--------+ ; (vl-load-com) (defun C:FLB (/ acsp adoc scl ang der ent gap midp mtx oid pline pref txp txt) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (or (not (zerop (setq scl (getvar "DIMSCALE")))) (setq scl 1.0)) ;(initget 6) ;(setq hgt (getdist "\nEnter text height <5.0>: ")) ;(if (not hgt)(setq hgt 5.)) ;(initget 6) ;(setq gap (getdist (strcat "\nEnter offset distance for text <" (rtos (* hgt 2) 2 1) ">: "))) ;(if (not gap)(setq gap (* hgt 2))) (setq gap (* 0.06 scl) hgt (* 0.06 scl)) (while (setq ent (entsel "\nSelect polyline (or press Enter to Exit) >>")) (setq oid (vla-get-objectid (setq pline (vlax-ename->vla-object (car ent)))) ) (setq midp (vlax-curve-getclosestpointto pline (vlax-curve-getpointatdist pline (/ (vla-get-length pline) 2))) ) ;;;(vlax-invoke acsp 'AddCircle midp 2.0) (setq der (vlax-curve-getfirstderiv pline (vlax-curve-getparamatpoint pline midp))) (if (zerop (cadr der)) (setq ang (/ pi 2)) (setq ang (- pi (atan (/ (car der) (cadr der))))) ) (if (> pi ang (/ pi 2)) (setq ang (+ ang pi))) (if (equal (rem ang (/ pi 2)) 0 0.001) (setq txp (polar midp ang (* gap 1.75))) (setq txp (polar midp (+ ang pi) (* gap 2.))) ) ;(setq pref (getstring T "\nEnter label prefix <920>: ")) ;(if (eq "" pref)(setq pref "920")) (setq pref (strcat "L =" " (")) (setq txt (strcat pref "%<\\AcObjProp Object(%<\\_ObjId " (itoa oid) ">%).Length \\f \"%lu2%pr2\">% m)") ) (setq mtx (vlax-invoke acsp 'AddMText txp 0.0 txt) ) (setq ang (- ang (/ pi 2))) (setq ang (cond ((> pi ang (/ pi 2))(+ pi ang)) ((> (* pi 1.5) ang pi)(- ang pi)) ((> (* pi 2) ang (* pi 1.5))(- (* pi 2) ang)) (T ang)) ) (vlax-put mtx 'Height hgt) (vlax-put mtx 'AttachmentPoint 5) (vlax-put mtx 'InsertionPoint txp) (vlax-put mtx 'Rotation ang) (vla-update mtx) ) (princ) ) (princ "\n Start command with FLB ...") (princ) ; +---------+---------+---------+---------+---------+---------+---------+ ; Quote Link to comment Share on other sites More sharing options...
Stryder Posted March 31, 2009 Share Posted March 31, 2009 THANK YOU VERY MUCH Lee Mac!!! You just made my day... and it's my b-day!!! Quote Link to comment Share on other sites More sharing options...
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.