Jump to content

draw chainage on polyline


motee-z

Recommended Posts

  • Replies 48
  • Created
  • Last Reply

Top Posters In This Topic

  • woodman78

    8

  • fixo

    6

  • motee-z

    3

  • Lee Mac

    3

Top Posters In This Topic

Posted Images

I believe this has been discussed a few times and routine(s) have been posted. Try searching for "stationing" which is the U.S. equivalent to "chainage".

Link to comment
Share on other sites

Hi, you can use block, create a line in block then use measure command,type block, block name and create the chainage line base on the measurement you want.

 

hope can help :_)

Link to comment
Share on other sites

I'm crazy busy and can't to rewrite it

to your exact needs but hope this

will get you started

 

(defun div-error (msg)
 (if
   (vl-position
     msg
     '("console break"
   "Function cancelled"
   "quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (while (> (getvar "cmdactive") 0) (command))
;;;  (command "._undo" "_end")
;;;  (command "._u")
 (setq *error* olderror)
 (princ)
)

(defun divplus (len segm / num lst)
 (setq num (fix (/ len segm)))
 (setq cnt 0)
 (while (<= cnt num)
   (setq tmp (* cnt segm))
   (setq lst (append lst (list tmp)))
   (setq cnt (1+ cnt))
 )
 (setq delta (- len (last lst)))
 (if (not (zerop delta))
   (setq lst (append lst (list (+ (last lst) delta))))
   lst
 )
)

(defun divminus    (len segm / lst)
 (while (>= len 0.)
   (setq lst (append lst (list len)))
   (setq len (- len segm))
 )
 (if (not (zerop (last lst)))
   (setq lst (append lst (list 0.0)))
 )
 lst
)

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.)
    (vlax-curve-getfirstderiv
      obj
      (vlax-curve-getparamatpoint
        obj
        pnt
      )
    )
 )
)

(defun answer (quest / wshl ans)
(or (vl-load-com))
(setq wshl (vlax-get-or-create-object "WScript.Shell"))
(setq ans (vlax-invoke-method
 wshl
 'Popup quest 7 "Answer This Question:" vlax-vbYesNo))
(vlax-release-object wshl)
(cond  ((= ans 6)
      (setq opt T))
      ((= ans 7)
      (setq opt nil))
      )
 opt
)



(defun make-station (bname /  acsp adoc atprom attag at_obj
            blk_obj hgt lay line_obj sfar )

 (vl-load-com)
 (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))
 )
 (vla-startundomark adoc)

 (if (not (tblsearch "block" bname))
 (progn
 (setq    attag  "NUMBER" ;(strcase (getstring "\nAttribute tag : \n"))
   atprom "NUMBER" ;(strcase (getstring T "\nAttribute prompt : \n"))
   hgt    1.0 ;(getreal "\nAttribute text height : \n")
 )

 (setq lay (getvar "clayer"))
 (setvar "clayer" "0")
 (setvar "attreq" 0)

 (setq line_obj (vlax-invoke acsp 'Addline '(0. 0. 0.) (list 0. (* hgt 12.) 0.)))
 (vla-put-color line_obj acyellow)
 (setq    blk_obj    (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) bname)
   sfar    (vlax-safearray-fill
         (vlax-make-safearray vlax-vbObject '(0 . 0))
         (list line_obj)
       )
 )
 (vla-copyobjects adoc sfar blk_obj)
;;;  RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 
 (setq at_obj (vla-addattribute blk_obj
        hgt
        acattributemodeverify
        atprom
        (vlax-3d-point '(-0.5 1. 0.))
        attag
        "0+00")
   )
;;;  (vla-put-alignment at_obj acAlignmentBottomCenter)
;;;  (vla-put-textalignmentpoint
;;;    at_obj
;;;    (vlax-3d-point '(0. 1. 0.))
;;;  )
 (vla-put-rotation at_obj (/ pi 2))
 (vlax-release-object blk_obj)
 )
 (progn
     (princ "\n\t >> Block does already exist!\n")
   (princ)))
 (if (tblsearch "block" bname)
   T
   (progn
     (alert "Impossible to add block")))
 (setvar "attreq" 1)
 (setvar "clayer" lay)
 (vl-catch-all-apply (function (lambda ()(vla-delete line_obj))))
 (vla-regen adoc acactiveviewport)
 (vla-endundomark adoc)
 (vlax-release-object acsp)
 (vlax-release-object adoc)
 (princ)
)

(or (vl-load-com))
(defun C:d10 (/    *error*     acsp      adoc       appd        div-error
          len    num     olderror pl       pt        pt_list
          step    util
         )

 (or adoc
     (setq adoc
        (vla-get-activedocument
          (vlax-get-acad-object)
        )
     )
 )
 (or appd (setq appd (vla-get-application adoc)))
 (or acsp
     (setq acsp
        (vla-get-block
          (vla-get-activelayout adoc)
        )
     )
 )
 (or util (setq util (vla-get-utility adoc)))
;;;  (command "._undo" "_end")
;;;  (command "._undo" "_mark")
 (setq olderror *error*)
 (setq *error* div-error)
;;;  (setq    bname  (getstring T "\nStation block name : \n"))
;;;  (make-station bname)
 (if (not (tblsearch "block" "Station"))
 (make-station "Station"))


 (vla-getentity
   util
   'pl
   'pt
   "\nSelect line NEAR OF POINT TO START measure: >>> \n"
 )
 (if pl
   (progn
 (setq step (getreal "\nEnter step for stationing <10> : \n"))
 (setq opt (answer "Rotate text perpendicularly to pline?"))
 (if (not step)(setq step 10.))

     (setq len    (vlax-curve-getdistatparam
         pl
         (vlax-curve-getendparam pl)
       )
     )

     (if (< (distance (vlax-safearray->list pt)
              (vlax-curve-getstartpoint pl)
        )
        (distance (vlax-safearray->list pt)
              (vlax-curve-getendpoint pl)
        )
     )
   (setq pt_list (divplus len step))
   (setq pt_list (divminus len step))
     )

     (setq
   pt_list    (vl-remove-if
         (function not)
         (mapcar (function (lambda (x)
                     (vlax-curve-getpointatdist pl x)
                   )
             )
             pt_list
         )
       )
     )

     (setq num 0)
;;;      (setq num (getint "\nEnter initial station number\n"))
     (mapcar
   (function
     (lambda (x / dr ang att_list at blk_obj)
       (progn

         (setq ang    (alg-ang pl x)
           ang
           (cond ((< (/ pi 2) ang (* pi 1.5)) (+ pi ang))
                 (T ang)
           )
         )
         (setq blk_obj (vlax-invoke
                 acsp 'Insertblock    x "Station" 1 1 1 ang)
         )
         (setq att_list (vlax-invoke blk_obj 'Getattributes))
         (foreach at att_list
       (if (eq (vlax-get at 'Tagstring) "NUMBER")
         (progn
           (vlax-put at 'Textstring (if (< num 990.)
   (strcat "sta: 0+" (rtos num 2 2))
(strcat "sta: "
   (itoa (fix (/ num 1000.)))[color=red];<--- changes 1200. on num (typo)[/color]
   "+"
   (rtos (- num (* (fix (/ num 1000.)) 1000)) 2 2)
   )
))
           (if (not opt)
           (vlax-put at 'Rotation 0))
           (vla-update at)
         )
       )
         )
         (vla-update blk_obj)
         (vlax-release-object blk_obj)
         (setq num (+ num step))
       )
     )
   )
   pt_list
     )

     (if (not (vlax-object-released-p pl))
   (vlax-release-object pl)
     )
   )
   (princ "\nNothing selected try again\n")
 )
 (vla-zoomextents appd)
 (vla-regen adoc acactiveviewport)
 (setq    *error*    olderror
   div-error nil
 )
;;;  (command "._undo" "_end")
 (princ)
)
(prompt "\n")
(prompt "\n    ***    Type D10 to execute    *** \n")
(princ)

 

~'J'~

Edited by fixo
typo has been found
Link to comment
Share on other sites

thank you fixo you only i want to explain my idea

your routin very great but when measuring reach to one thousnd there is mistake here so total length not correct please modify it

thanks

Link to comment
Share on other sites

thank you fixo you only i want to explain my idea

your routin very great but when measuring reach to one thousnd there is mistake here so total length not correct please modify it

thanks

 

Sorry, I'm busy at the moment

Perhaps, later I can do it

 

~'J'~

Link to comment
Share on other sites

Forgot to say about

I wan't to work with your picture

Upload here your real working drawing

that would be much easier to help you

 

~'J'~

Link to comment
Share on other sites

  • 1 year later...

Thanks for this excellent routine.

One thing if anyone could help me, what do I need to change in the routine to rotate the text of the chainages by 180 degrees.

 

many thanks

 

Cymro

Link to comment
Share on other sites

  • 6 months later...

Hi, me again. I am using the above routine quite often now,

 

I have tried and tried to change the code to rotate the text by 180 degrees without success. If there is anyone out there who can do it quickly, it would be greatly appreciated. It takes a long time to manually rotate text.

 

many thanks

 

Cymro

Link to comment
Share on other sites

This part including the rotation text for the Att. text tags .

 

(vla-put-rotation at_obj (/ pi 2)); <-- this is 90 degree to make it 180. replace the (/ pi 2) to pi 

And when the routine asks you for rotation, hit NO to let the routine gets your angular degree that you added to the routine.

Link to comment
Share on other sites

chainage.jpg

 

Hi thanks for getting back,

I may not have explained myself fully.

What I would like is when asked for text perpendicular to pline the output is rotated 180 to what is produced at present.

 

The left is what the code produces after confirming text rotated perpendicular to line, the right is the output that i would like.

 

Hope someone can help

 

many thanks

 

Stephen

Link to comment
Share on other sites

  • 7 months later...

Hi fixo your lsp is great, but can chainage continue to for example 30 000 meters.

Because when it com to 1+990 it start's again from 0+000,00, Can you help me Fixo with this so that the chainage go to 30+000,00 or more.

Link to comment
Share on other sites

  • 5 months later...
Hi fixo your lsp is great, but can chainage continue to for example 30 000 meters.

Because when it com to 1+990 it start's again from 0+000,00, Can you help me Fixo with this so that the chainage go to 30+000,00 or more.

 

I've found a typo in this routine, try edited code from post #5 again

And also it would be goog to see your stationing format

sou you could be want to attach the picture of small piece of

your polyline, to be frankly it's looking ugly (this one is from my very oldies)

Think I'll back to it to rewrite some parts in there

Link to comment
Share on other sites

(defun answer (quest / wshl ans) 
(or (vl-load-com)) 
(setq wshl  (vlax-get-or-create-object "WScript.Shell")) 
(setq ans  (vlax-invoke-method   wshl   'Popup quest 7 "Answer This Question:" vlax-vbYesNo)) 
(vlax-release-object wshl)
(cond  ((= ans 6)  (setq  opt T)) 
           ((= ans 7)  (setq opt nil)))
            opt )
...................
(setq opt (answer "Rotate text perpendicularly to pline?"))
...................

Hai Oleg,

 

This function is new to me. I like it. And I'll keep in my lib.

 

Thank you.

 

mardi

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