Jump to content

Need Help With Polyline labeling


Krztoff

Recommended Posts

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!

Link to comment
Share on other sites

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • fixo

    9

  • Krztoff

    8

  • Lee Mac

    3

  • Stryder

    2

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 1 month later...

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.

Link to comment
Share on other sites

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)
; +---------+---------+---------+---------+---------+---------+---------+ ;

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...