runner214 Posted June 4, 2010 Share Posted June 4, 2010 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/showthread.php?t=24278&highlight=chainage) I have attached the converted lisp file and my working dwg Thanks Quote Link to comment Share on other sites More sharing options...
fixo Posted June 5, 2010 Share Posted June 5, 2010 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/showthread.php?t=24278&highlight=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'~ Quote Link to comment Share on other sites More sharing options...
runner214 Posted June 5, 2010 Author Share Posted June 5, 2010 Thank you fixo, works fine. Appreciate you finding the time to help. Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 5, 2010 Share Posted June 5, 2010 This one is from oldies I don't remember how it worksIt 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted June 5, 2010 Share Posted June 5, 2010 Thank you fixo, works fine. Appreciate you finding the time to help. You're welcome ~'J'~ Quote Link to comment Share on other sites More sharing options...
runner214 Posted June 5, 2010 Author Share Posted June 5, 2010 Is there anyway the block can be pre-loaded or code added to create the block 'station' ? Quote Link to comment Share on other sites More sharing options...
fixo Posted June 5, 2010 Share Posted June 5, 2010 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'~ Quote Link to comment Share on other sites More sharing options...
runner214 Posted June 5, 2010 Author Share Posted June 5, 2010 Thanks fixo - that did the trick!:wink: Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 5, 2010 Share Posted June 5, 2010 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted June 6, 2010 Share Posted June 6, 2010 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'~ Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 6, 2010 Share Posted June 6, 2010 Hi Steve, I don't know an imperic standards Can you fix what you said? ~'J'~ I'll try to explain further. When you create the block in the code, keep the line as it is and just rotate (create) the text 180 degrees from its present orientation. Keep the attribute location as is, only rotated 180 degrees. Like this NUMBER read from top to bottom not from bottom to top. S Quote Link to comment Share on other sites More sharing options...
runner214 Posted June 6, 2010 Author Share Posted June 6, 2010 I can see what you mean by the location placements of the stations. I looked at an alignment created with Terramodel and the station labels are displayed below the horizonal alignment line. (can supply a screen shot if needed) Will experiment a bit with your suggestion, as I would believe this to be the standard view of a horizonal alignment w/stationing. Thanks Quote Link to comment Share on other sites More sharing options...
runner214 Posted June 6, 2010 Author Share Posted June 6, 2010 The attached dwg is what I came up with by inserting the block "station". When loading a new file, the original display (above line) comes up until I insert my "station" which overwrites. My self made "station" block allowed me to redefine the insertion point. Any suggestions? Quote Link to comment Share on other sites More sharing options...
fixo Posted June 6, 2010 Share Posted June 6, 2010 The attached dwg is what I came up with by inserting the block "station". When loading a new file, the original display (above line) comes up until I insert my "station" which overwrites. My self made "station" block allowed me to redefine the insertion point. Any suggestions? Try edited code in the post #7 ~'J'~ Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 6, 2010 Share Posted June 6, 2010 Try edited code in the post #7 ~'J'~ I don't think anything has been edited in post #7, its the same code as yesterday where you had the program create the block ! S Quote Link to comment Share on other sites More sharing options...
fixo Posted June 6, 2010 Share Posted June 6, 2010 I don't think anything has been edited in post #7, its the same code as yesterday where you had the program create the block !S See this line of code (setq line_obj (vlax-invoke blk_obj 'Addline '(0. 0. 0.) (list 0. [color=red]12.0[/color] 0.))) Better yet to attach the picture with this block as it will be looks like I've never used it for my own needs ~'J'~ Quote Link to comment Share on other sites More sharing options...
mgraubart Posted June 8, 2010 Share Posted June 8, 2010 I've been trying to tweak your code in order to make the stations count up by 100. The formatting my boss would like is "100+00, 101+00, 102+00 etc." Its probably an easy fix, but I'm mixing something up with formatting. Any help would be appreciated. Thanks, Matt Quote Link to comment Share on other sites More sharing options...
fixo Posted June 9, 2010 Share Posted June 9, 2010 I've been trying to tweak your code in order to make the stations count up by 100. The formatting my boss would like is "100+00, 101+00, 102+00 etc." Its probably an easy fix, but I'm mixing something up with formatting. Any help would be appreciated. Thanks, Matt Hi Matt, I'm kinda busy a little so I'll edit an incrementing part to your suit later, think near to the night Attach the sample drawing and drop 3-4 stations from start in there manually for the best understanding for me ~'J'~ Quote Link to comment Share on other sites More sharing options...
mgraubart Posted June 9, 2010 Share Posted June 9, 2010 Alright. A sample drawing is attached. I had tweaked a few of the display portions of your code such as rotation of the text etc. Don't worry about having it look like I have it in the sample. The main issue for me is getting the counter to increment by 100 with a format of 100+00, 101+00, 102+00, 103+00, etc. Thanks again, Matt sample drawing - baseline.dwg Quote Link to comment Share on other sites More sharing options...
fixo Posted June 9, 2010 Share Posted June 9, 2010 Alright. A sample drawing is attached. I had tweaked a few of the display portions of your code such as rotation of the text etc. Don't worry about having it look like I have it in the sample. The main issue for me is getting the counter to increment by 100 with a format of 100+00, 101+00, 102+00, 103+00, etc. Thanks again, Matt Ok, I will try Is it always starting from 100+00? Or you want the user input for initial value? ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.