Inquiry: Station Labeling

[runner214]

If anyone could direct me as to what code is needed to increase a station value.

The attached lisp references an earlier thread (http://www.cadtutor.net/forum/showth...light=chainage)

I have attached the converted lisp file and my working dwg

Thanks

[fixo]

If anyone could direct me as to what code is needed to increase a station value.

The attached lisp references an earlier thread (http://www.cadtutor.net/forum/showth...light=chainage)

I have attached the converted lisp file and my working dwg

Thanks

This one is from oldies I don't remember how it works
It was written for one fellow from Croatia as I remember it

;; written by Fatty T.O.H. ()2004 * all rights removed
;; edited 6/5/10
;; Stationing
;;load ActiveX library
(vl-load-com)
;;local defuns
;;//
(defun start (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getstartpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun end (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getendpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun pointoncurve (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  pt
    )
  )
)
    )
  )
;;//
(defun paramatpoint (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getparamatpoint curve
  pt
    )
  )
)
    )
  )
;;//
(defun distatpt (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatpoint curve
    (vlax-curve-getclosestpointto curve pt)
    )
  )
    )
    )
  )
;;//
(defun pointatdist (curve dist)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getpointatdist curve dist)
    )
  )
)
    )
  )
;;//
(defun curvelength (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  (- (vlax-curve-getendparam curve)
     (vlax-curve-getstartparam curve)
    )
  )
  )
)
    )
  )
;;//
(defun distatparam (curve param)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  param
  )
  )
    )
    )
  )
;;//
(defun statlabel (num step)
;; num - integer, zero based
;; step - double or integer, must be non zero
            (strcat
     (itoa (fix (/ num 2.)) )
     "+"
     (rtos (* (* step 2) (- (/  num 2.) (fix (/ num 2.)))) 2 2)
     )
     )
 
;;//
(defun insertstation (acsp bname pt rot tag num step / block)
  (vl-catch-all-apply
    (function (lambda()
     (setq block (vlax-invoke-method acsp 'InsertBlock pt bname 1 1 1 rot))
  )
       )
    )
  (changeatt block tag (statlabel num step))
block
  )
;;//
(defun changeatt (block tag value / att)
  (setq atts (vlax-invoke block 'GetAttributes))
  (foreach att atts
    (if (equal tag (vla-get-tagstring att))
      (vla-put-textstring att value)
      )
    )
    )
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)
 
  (setq param (paramatpoint curve pt)
        ang ((lambda (deriv)
     (if (zerop (cadr deriv))
       (/ pi 2)
       (atan (apply '/ deriv))
     )
   )
    (cdr (reverse
    (vlax-curve-getfirstderiv curve param)
         )
    )
  )
)
  ang
  )
;;//
(defun c:st50 (/ acsp adoc block blkdef cnt en ent label lastp
          leng mul nop num pt rot sign start step)
 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
    acsp (vla-get-block (vla-get-activelayout adoc))
     )
 (if (not (tblsearch "block" "Station"))
   (progn
     (alert "Block \"Station\" does not exist. Error...")
     (exit)(princ)
     )
   )
 
  (setq blkdef (vla-item (vla-get-blocks adoc) "Station"))
  (setq nop T)
  (vlax-for item blkdef
    (if (not (and (eq "AcDbAttributeDefinition" (vla-get-objectname item))
      (eq "NUMBER" (vla-get-tagstring item))))
      (setq nop nil)
      )
    )
 
   (if nop
   (progn
     (alert "Block \"Station\" has not attribute \"NUMBER\". Error...")
     (exit)(princ)
     )
   )
 
(setq step 50.)
 
(if
  (setq
    ent (entsel
   "\nSelect curve near to the start point >>"
 )
  )
   (progn
     (setq en (car ent)
    pt (pointoncurve en (cadr ent))
    leng (distatparam en (vlax-curve-getendparam en))
     )
     (setq num (fix (/ leng step))
     )
     (setq mul (- leng (* num step))
     )
     (if (not (zerop mul))
       (setq lastp T)
       (setq lastp nil)
     )
     (if (> (- (paramatpoint en pt)
        (paramatpoint en (vlax-curve-getstartpoint en))
     )
     (- (paramatpoint en (vlax-curve-getendpoint en))
        (paramatpoint en pt)
     )
  )
       (progn
  (setq start leng
        sign  -1
  )
  )
       (progn
  (setq start (distatparam en (vlax-curve-getstartparam en))
        sign  1
  )
       )
     )
 
     (vla-startundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
     (setq cnt 0)
     (repeat (1+ num)
       (setq pt  (pointatdist en start)
      rot (gettangent en pt)
       )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" cnt step)
     )
 
       (setq cnt   (1+ cnt)
      start (+ start (* sign step))
       )
     )
 
  (if lastp
    (progn
    (if (= sign -1)
    (progn
      (setq pt  (vlax-curve-getstartpoint en)
      rot (gettangent en pt)
       )
      )
      (progn
      (setq pt  (vlax-curve-getendpoint en)
      rot (gettangent en pt)
       )
      )
      )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" (1- cnt) 0)
     )
    (setq label (statlabel (1- cnt) 50.)
   label (strcat (substr label 1 (1+ (vl-string-search "+" label)))
   (rtos mul 2 2))
   )
    (changeatt block "NUMBER" label)
    )
    )
 
     (vla-endundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
   )
   (princ "\nNothing selected")
)
(princ)
)
(prompt "\n   >>>   Type ST50 to execute...")
(prin1)

~'J'~

[runner214]

Thank you fixo, works fine.

Appreciate you finding the time to help.

[stevesfr]

This one is from oldies I don't remember how it works
It was written for one fellow from Croatia as I remember it

;; written by Fatty T.O.H. ()2004 * all rights removed
;; edited 6/5/10
;; Stationing
;;load ActiveX library
(vl-load-com)
;;local defuns
;;//
(defun start (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getstartpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun end (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getendpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun pointoncurve (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  pt
    )
  )
)
    )
  )
;;//
(defun paramatpoint (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getparamatpoint curve
  pt
    )
  )
)
    )
  )
;;//
(defun distatpt (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatpoint curve
    (vlax-curve-getclosestpointto curve pt)
    )
  )
    )
    )
  )
;;//
(defun pointatdist (curve dist)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getpointatdist curve dist)
    )
  )
)
    )
  )
;;//
(defun curvelength (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  (- (vlax-curve-getendparam curve)
     (vlax-curve-getstartparam curve)
    )
  )
  )
)
    )
  )
;;//
(defun distatparam (curve param)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  param
  )
  )
    )
    )
  )
;;//
(defun statlabel (num step)
;; num - integer, zero based
;; step - double or integer, must be non zero
            (strcat
     (itoa (fix (/ num 2.)) )
     "+"
     (rtos (* (* step 2) (- (/  num 2.) (fix (/ num 2.)))) 2 2)
     )
     )
 
;;//
(defun insertstation (acsp bname pt rot tag num step / block)
  (vl-catch-all-apply
    (function (lambda()
     (setq block (vlax-invoke-method acsp 'InsertBlock pt bname 1 1 1 rot))
  )
       )
    )
  (changeatt block tag (statlabel num step))
block
  )
;;//
(defun changeatt (block tag value / att)
  (setq atts (vlax-invoke block 'GetAttributes))
  (foreach att atts
    (if (equal tag (vla-get-tagstring att))
      (vla-put-textstring att value)
      )
    )
    )
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)
 
  (setq param (paramatpoint curve pt)
        ang ((lambda (deriv)
     (if (zerop (cadr deriv))
       (/ pi 2)
       (atan (apply '/ deriv))
     )
   )
    (cdr (reverse
    (vlax-curve-getfirstderiv curve param)
         )
    )
  )
)
  ang
  )
;;//
(defun c:st50 (/ acsp adoc block blkdef cnt en ent label lastp
          leng mul nop num pt rot sign start step)
 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
    acsp (vla-get-block (vla-get-activelayout adoc))
     )
 (if (not (tblsearch "block" "Station"))
   (progn
     (alert "Block \"Station\" does not exist. Error...")
     (exit)(princ)
     )
   )
 
  (setq blkdef (vla-item (vla-get-blocks adoc) "Station"))
  (setq nop T)
  (vlax-for item blkdef
    (if (not (and (eq "AcDbAttributeDefinition" (vla-get-objectname item))
      (eq "NUMBER" (vla-get-tagstring item))))
      (setq nop nil)
      )
    )
 
   (if nop
   (progn
     (alert "Block \"Station\" has not attribute \"NUMBER\". Error...")
     (exit)(princ)
     )
   )
 
(setq step 50.)
 
(if
  (setq
    ent (entsel
   "\nSelect curve near to the start point >>"
 )
  )
   (progn
     (setq en (car ent)
    pt (pointoncurve en (cadr ent))
    leng (distatparam en (vlax-curve-getendparam en))
     )
     (setq num (fix (/ leng step))
     )
     (setq mul (- leng (* num step))
     )
     (if (not (zerop mul))
       (setq lastp T)
       (setq lastp nil)
     )
     (if (> (- (paramatpoint en pt)
        (paramatpoint en (vlax-curve-getstartpoint en))
     )
     (- (paramatpoint en (vlax-curve-getendpoint en))
        (paramatpoint en pt)
     )
  )
       (progn
  (setq start leng
        sign  -1
  )
  )
       (progn
  (setq start (distatparam en (vlax-curve-getstartparam en))
        sign  1
  )
       )
     )
 
     (vla-startundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
     (setq cnt 0)
     (repeat (1+ num)
       (setq pt  (pointatdist en start)
      rot (gettangent en pt)
       )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" cnt step)
     )
 
       (setq cnt   (1+ cnt)
      start (+ start (* sign step))
       )
     )
 
  (if lastp
    (progn
    (if (= sign -1)
    (progn
      (setq pt  (vlax-curve-getstartpoint en)
      rot (gettangent en pt)
       )
      )
      (progn
      (setq pt  (vlax-curve-getendpoint en)
      rot (gettangent en pt)
       )
      )
      )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" (1- cnt) 0)
     )
    (setq label (statlabel (1- cnt) 50.)
   label (strcat (substr label 1 (1+ (vl-string-search "+" label)))
   (rtos mul 2 2))
   )
    (changeatt block "NUMBER" label)
    )
    )
 
     (vla-endundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
   )
   (princ "\nNothing selected")
)
(princ)
)
(prompt "\n   >>>   Type ST50 to execute...")
(prin1)

~'J'~

This is pretty neat. In order for this to work, make a block called STATION with one attribute called NUMBER
the block can be just a short vertical line with the attribute above the vertical line, the insertion point of the block can be the bottom of the short vertical line. Save the block as STATION and window the short vertical line and the attribute called NUMBER.
Cheers !!
Steve

[fixo]

Thank you fixo, works fine.

Appreciate you finding the time to help.

You're welcome

~'J'~

[runner214]

Is there anyway the block can be pre-loaded or code added to create the block 'station' ?

[fixo]

Is there anyway the block can be pre-loaded or code added to create the block 'station' ?

Try edited lisp instead

;; written by Fatty T.O.H. ()2004 * all rights removed
;; edited 6/5/10
;; Stationing
;;load ActiveX library
(vl-load-com)
;;local defuns
;//
(defun makeblock (adoc aprompt atag bname txtheight tstyle / at_obj blk_obj lay line_obj tst)
(if (not (tblsearch "block" bname))
  (progn
  (setq tst (getvar "textstyle"))
  (setvar "textstyle" tstyle)
  (setq lay (getvar "clayer"))
  (setvar "clayer" "0")
 
  (setq blk_obj (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) bname))
  (setq line_obj (vlax-invoke blk_obj 'Addline '(0. 0. 0.) (list 0. 12.0 0.)))
  (vla-put-color line_obj acyellow)
  (setq at_obj (vla-addattribute blk_obj
   txtheight
   acattributemodeverify
   aprompt
   (vlax-3d-point '(-0.5 1. 0.))
   atag
   "0+0.00")
 )
  (vla-put-rotation at_obj (/ pi 2))
  (vla-put-color at_obj acwhite)
  (mapcar (function (lambda(x) vlax-release-object x))
   (list at_obj line_obj blk_obj )
   )
  (setvar "clayer" lay)
  (setvar "textstyle" tst)
  )
  )
  )
;;//
(defun start (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getstartpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun end (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getendpoint curve
    )
  )
)
    )
  )
  )
;;//
(defun pointoncurve (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  pt
    )
  )
)
    )
  )
;;//
(defun paramatpoint (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getparamatpoint curve
  pt
    )
  )
)
    )
  )
;;//
(defun distatpt (curve pt)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatpoint curve
    (vlax-curve-getclosestpointto curve pt)
    )
  )
    )
    )
  )
;;//
(defun pointatdist (curve dist)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getclosestpointto curve
  (vlax-curve-getpointatdist curve dist)
    )
  )
)
    )
  )
;;//
(defun curvelength (curve)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  (- (vlax-curve-getendparam curve)
     (vlax-curve-getstartparam curve)
    )
  )
  )
)
    )
  )
;;//
(defun distatparam (curve param)
  (vl-catch-all-apply (function (lambda()
  (vlax-curve-getdistatparam curve
  param
  )
  )
    )
    )
  )
;;//
(defun statlabel (num step)
;; num - integer, zero based
;; step - double or integer, must be non zero
            (strcat
     (itoa (fix (/ num 2.)) )
     "+"
     (rtos (* (* step 2) (- (/  num 2.) (fix (/ num 2.)))) 2 2)
     )
     )
 
;;//
(defun insertstation (acsp bname pt rot tag num step / block)
  (vl-catch-all-apply
    (function (lambda()
     (setq block (vlax-invoke-method acsp 'InsertBlock pt bname 1 1 1 rot))
  )
       )
    )
  (changeatt block tag (statlabel num step))
block
  )
;;//
(defun changeatt (block tag value / att)
  (setq atts (vlax-invoke block 'GetAttributes))
  (foreach att atts
    (if (equal tag (vla-get-tagstring att))
      (vla-put-textstring att value)
      )
    )
    )
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)
 
  (setq param (paramatpoint curve pt)
        ang ((lambda (deriv)
     (if (zerop (cadr deriv))
       (/ pi 2)
       (atan (apply '/ deriv))
     )
   )
    (cdr (reverse
    (vlax-curve-getfirstderiv curve param)
         )
    )
  )
)
  ang
  )
;;//
(defun c:st50 (/ acsp adoc block blkdef cnt en ent label lastp
          lay leng mul nop num pt rot sign start step)
  (setvar "dimzin" 2)
  (setq lay (getvar "clayer"))
  (setvar "clayer" "0")
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
    acsp (vla-get-block (vla-get-activelayout adoc))
     )
 
 (if (not (tblsearch "block" "Station"))
   (makeblock adoc "NUMBER" "NUMBER" "Station" 2.0 "Standard")
   )
 
(setq step 50.)
 
(if
  (setq
    ent (entsel
   "\nSelect curve near to the start point >>"
 )
  )
   (progn
     (setq en (car ent)
    pt (pointoncurve en (cadr ent))
    leng (distatparam en (vlax-curve-getendparam en))
     )
     (setq num (fix (/ leng step))
     )
     (setq mul (- leng (* num step))
     )
     (if (not (zerop mul))
       (setq lastp T)
       (setq lastp nil)
     )
     (if (> (- (paramatpoint en pt)
        (paramatpoint en (vlax-curve-getstartpoint en))
     )
     (- (paramatpoint en (vlax-curve-getendpoint en))
        (paramatpoint en pt)
     )
  )
       (progn
  (setq start leng
        sign  -1
  )
  )
       (progn
  (setq start (distatparam en (vlax-curve-getstartparam en))
        sign  1
  )
       )
     )
 
     (vla-startundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
     (setq cnt 0)
     (repeat (1+ num)
       (setq pt  (pointatdist en start)
      rot (gettangent en pt)
       )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" cnt step)
     )
 
       (setq cnt   (1+ cnt)
      start (+ start (* sign step))
       )
     )
 
  (if lastp
    (progn
    (if (= sign -1)
    (progn
      (setq pt  (vlax-curve-getstartpoint en)
      rot (gettangent en pt)
       )
      )
      (progn
      (setq pt  (vlax-curve-getendpoint en)
      rot (gettangent en pt)
       )
      )
      )
      (setq block
      (insertstation acsp "Station"
        (vlax-3d-point pt)
        rot
        "NUMBER" (1- cnt) 0)
     )
    (setq label (statlabel (1- cnt) 50.)
   label (strcat (substr label 1 (1+ (vl-string-search "+" label)))
   (rtos mul 2 2))
   )
    (changeatt block "NUMBER" label)
    )
    )
    (setvar "clayer" lay)
     (vla-endundomark
       (vla-get-activedocument (vlax-get-acad-object))
     )
   )
   (princ "\nNothing selected")
)
(princ)
)
(prompt "\n   >>>   Type ST50 to execute...")
(prin1)

~'J'~

[runner214]

Thanks fixo - that did the trick!

[stevesfr]

Really need to flip the block 180 degrees.
when "walking" along the line to which stationing is assigned
you have to read upside down !!
just my opinion and 2 cents

of course one could use the first version and make their own block.
S

[fixo]

Really need to flip the block 180 degrees.
when "walking" along the line to which stationing is assigned
you have to read upside down !!
just my opinion and 2 cents

of course one could use the first version and make their own block.
S

Hi Steve, I don't know an imperic standards

Can you fix what you said?

~'J'~