Need Help With Polyline labeling

[Krztoff]

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!

[fixo]

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'~

[Krztoff]

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!!!

[fixo]

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'~

[Krztoff]

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!

[fixo]

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'~

[Krztoff]

Ok, no problem, it's not that urgent, thanks!

[fixo]

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'~

[fixo]

Let me know how it's worked
I haven't time to test it at the moment

~'J'~

[Krztoff]

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!