Stationing every intersection along a polyline in AutoCAD LT

[j_deal6K36N]

I am trying to find a lisp that will make stationing easier. I have been scouring the internet and found something that is close to what I need but not quite. I have been using this http://www.gilesdarling.me.uk/lisproutines.shtml#chmark and it has worked phenomenally, but I need something that automatically stations every intersection on a certain line and has the 1+23 stationing format. This lisp works so well, but manually clicking on intersections is still tedious. I don't have access to Civil 3D to take advantage of the alignment command. I only have AutoCAD LT. Every lisp that I found that came close to what I need doesn't work or it is outdated or only does stationing at constant intervals. Is there anything out there that does what I need?

 

[ВeekeeCZ]

LT 24+?

[j_deal6K36N]

Yes LT 2025.

[Sea-Haven]

Just a maybe search for "Chainage" lisp there are many versions out there and a lot do the 1+234 etc. It will be a case of finding one that does points, else using (vlax-curve-getdistatpoint pl pt) will give you the length of each point compared to the start. Here in AUS we don't use x+xxx so no code.

This is the points of a pline.

(setq plent (entsel "\nPick pline "))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))

In the chainage code once you have a length shows how to convert to x+xxx and get rotation for text.

[j_deal6K36N]

I've searched everywhere and cannot find a Chainage that works how I want it to work. Sometimes the code returns errors or they just don't work. I also have no knowledge on any coding.

[Sea-Haven]

Ok need a sample dwg I dont do x+xxx so I expect some one else will pull the make text x+xxx part out of the chainage code.  Just for my info what is 20+87 as a normal number. 2087 , 20870 ?

[j_deal6K36N]

20+87 would be 2087. The stationing I do is usually a + in between the hundreds and tens place. So 1 is 0+01, 100 is 1+00, 72384 is 723+84, etc. In this sample dwg, what specifically do you need me to have?

[Sea-Haven]

That is enough. I am surprised no one answered.

Try this.

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/stationing-every-intersection-along-a-polyline-in-autocad-lt/m-p/13196335/highlight/false#M475706
; chainage label at 100 unit increments.
; By AlanH Dec 2024

(defun c:ch100 ( / alg-ang ang angdir ch co-ord d1 d2 end ent old oldaunits oldsnap pt start)
(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)


(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldangdir (getvar 'angdir))
(setvar 'angdir 0)

(setq txtsz (getreal "\nEnter textsize "))
(setq ent (entsel "\nPIck pline near end "))
(setq pt (cadr ent))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq obj (vlax-ename->vla-object (car ent)))
(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getendPoint obj))
(setq d1 (distance pt start))
(setq d2 (distance pt end))

(if (> d1 d2)
  (command "pedit" ent "R" "")
)

(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))

(setq ch (getint "\nEnter start chainage "))

(setq ang (alg-ang obj (vlax-curve-getstartPoint obj)))
(command "text" (vlax-curve-getstartPoint obj) txtsz ang (strcat (rtos (/ ch 100.0) 2 0) "+00"))
(setq x 0)
(repeat (- (length co-ord) 1)
  (setq pt (nth (setq x (1+ x)) co-ord))
  (setq ang (alg-ang obj pt))
  (setq len (+ ch (vlax-curve-getdistatpoint obj pt)))
  (setq pre (fix (/ len 100.0)))
  (setq suf (* (- (/ len 100) pre) 100.0))
  (command "text" (nth x co-ord) 25 ang (strcat (rtos pre 2 0) "+" (rtos suf 2 0)))
)

(setvar 'osmode oldsnap)
(setvar 'aunits oldaunits)
(setvar 'angdir oldangdir)

(princ)
)

[j_deal6K36N]

That is almost what I would need. I have attached an example DWG on what I am looking for. Not necessarily every vertex on a line, but wherever a line crosses or touches the line and also the stationing oriented perpendicular to the line.

[Sea-Haven]

Ok your home work a simple answer I gave you start and end ch's, to get the pt at the intersection of your alignment and a crossing line you use something like this.

(setq intpt (vlax-invoke obj 'intersectWith objX acExtendNone))

So you select the alignment OBJ then select all crossing lines using ssget and loop through a selection set getting objX, getting the intpt and using instead of pt as per my code already provided. It is a good lisp learning task as you only have to edit code not start again.

[j_deal6K36N]

Honestly, none of this code makes sense to me. I have little to no knowledge on any programming/coding so I can't wrap my brain around any of this.

[Sea-Haven]

Ok watch this space.

Ok 1st problem the gas connections are in layer 0 thats a problem as may get wrong objects, so I have done you a bonus lisp to draw objects. 1st step is have layers for your services GAS WATER ELEC SEWER, as some else said its sloppy drafting. 

This lisp you offset an existing pline, then just pick points and it will draw a 90 line to the pline. Press enter to stop then erase dummy offset.

(defun c:perps ( / ent pt1 pt2 obj dist)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 512)
(setq ent (entsel "\nPick pline "))
(setq pt1 (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq dist (distance pt1 (setq pt2 (getpoint pt1 "\nPick offset point "))))
(command "offset" dist (car ent) pt2 "")
(setvar 'clayer (cdr (assoc 8 (entget ent))))
(while (setq pt1 (getpoint "\nPick point Enter to stop "))
(setq pt2 (vlax-curve-getclosestpointto obj pt1))
(command "line" pt1 pt2 "")
)
(princ)
)

(defun c:CHX ( / alg-ang ang angdir ch co-ord d1 d2 end ent old oldaunits oldsnap pt start)
(defun alg-ang (obj pnt)
 (+ (/ pi 2.0) (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
  )
)


(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
(setq oldangdir (getvar 'angdir))
(setvar 'angdir 0)

(setq txtsz (getreal "\nEnter textsize "))

(setq ent (entsel "\nPIck pline near end "))
(setq pt (cadr ent))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq obj (vlax-ename->vla-object (car ent)))
(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getendPoint obj))
(setq d1 (distance pt start))
(setq d2 (distance pt end))

(if (> d1 d2)
  (command "pedit" ent "R" "")
)

(setvar 'textstyle "standard")

(setvar 'osmode 0)

(setq ch (getint "\nEnter start chainage "))
(setvar 'clayer "Station Reference")
(setq ang (alg-ang obj (vlax-curve-getstartPoint obj)))
(command "text" (vlax-curve-getstartPoint obj) txtsz ang (strcat (rtos (/ ch 100.0) 2 0) "+00"))

(setq ang (alg-ang obj (vlax-curve-getendPoint obj)))
(setq len (vlax-get obj 'length))
(setq pre (fix (/ (+ len ch) 100.0)))
(setq suf (* (- (/ (+ len ch) 100) pre) 100.0))
(command "text" (vlax-curve-getendPoint obj) txtsz ang (strcat (rtos pre 2 0) "+" (rtos suf 2 0)))

(setq lay (cdr (assoc 8 (entget (car (entsel "\nSelect an object for crossing layer "))))))
(setq ss (ssget (list (cons 0 "LINE")(cons 8 lay))))

(repeat (setq x (sslength ss))
  (setq objx (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
  (setq pt (vlax-invoke obj 'intersectWith objX acExtendNone))
  (setq ang (alg-ang obj pt))
  (setq len (+ ch (vlax-curve-getdistatpoint obj pt)))
  (setq pre (fix (/ len 100.0)))
  (setq suf (* (- (/ len 100) pre) 100.0))
  (command "text" pt txtsz ang (strcat (rtos pre 2 0) "+" (rtos suf 2 0)))
)

(setvar 'osmode oldsnap)
(setvar 'aunits oldaunits)
(setvar 'angdir oldangdir)

(princ)
)

(c:chx)

[wanslowXBVQD]

Thanks for sharing this information and coding.  I've tried to get CHX and PERPS lisps to work but both are running into issues and will not execute.  PERPS is just more or less just turning off all my osnaps and doesn't create the perp lines to adjacent polyline objects.  The CHX asks for a starting chainage but will not proceed any further past that point.  Any chance you provide an example of how to input the commands?  

[Sea-Haven]

Post your dwg so can see what is happening. Put some labels in the dwg or do a before after so can see what is required.