draw chainage on polyline

[motee-z]

Hello to all

can any one help to draw chainage for equal distance on a polyline as in attached jpg

[CarlB]

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

[jason tay]

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

[CarlB]

Maybe this one -?

 

http://www.cadtutor.net/forum/showthread.php?t=3876

 

or, DC_Chains at http://afralisp.net/lisp/dctools.htm

[fixo]

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 January 16, 2012 by fixo
typo has been found

[motee-z]

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

[fixo]

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

[fixo]

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

[motee-z]

thank you fixo for your help

thanks to carlB for the link it solved what i need exactly

[Cymro]

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

[Cymro]

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

[Michaels]

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.

[Cymro]

 

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

[irneb]

It seems you want to "reverse" the polyline first. There are a few things which can do such, as a sample see alanjt's over here.

[alanjt]

This may also be of interest.

 

[Tomica]

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.

[cios106]

Hi all. Im always using "defun c:" type lisps. So i could not run Fixo's lisp, how can i run it ? What should i type to use it ? Many many thanks.

[irneb]

You could try his c:d10 defun, though it uses a block named Station. You could edit it I suppose.

[fixo]

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

[m4rdy]

(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