;sorry I deleted the original, then realized this thread had 800 views. I tried to put it back(this one works).
;see attachment for second half
Code:
(DEFUN C:STA ()
(SETQ LUG (GETVAR "LUNITS"))
(IF (= LUG 2) (C:STAD))
(IF (OR (= LUG 3) (= LUG 4)) (C:STAE))
);END STA
(DEFUN C:STAD (/ LP BP LOP LUP SLPS SLEN SLPP SLNPP SLEPP SLLA SLL CL SL NO SMN XS EV1 EVS SV EV2 PEP1 PEP2 FIP MARK NMSS DBO ISMN DBF LOOP IP RA PM SMSP SMSS SMS JC1 JC2 JS FLTR)
(SETQ TDSD (RTOS (GETVAR "CDATE") 2 8))
(setq osm (getvar "osmode"))
(command "osnap" "off")
(SETQ CMDE (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(SETQ DBO 0)
(SETQ LU (GETVAR "LUNITS"))
(SETQ ISMN 0)
(SETQ NO NIL)
(PROMPT "\n*STATION MARK*")
(SETQ LP 1)
(WHILE LP
(SETQ BP (GETPOINT "\nPick first station location: "))
(SETQ BP (OSNAP BP "NEA"))
(IF (/= BP NIL) (SETQ LP NIL) (PROMPT " POINT NOT ON STATION LINE "))
);END WHILE LP
(SETQ LUP 1)
(WHILE LUP
(COMMAND "ZOOM" "C" BP "1.0")
(SETQ LOP 1)
(WHILE LOP
(SETQ SLPS (ENTSEL "\nSelect station line: "))
(IF (/= SLPS NIL) (SETQ LOP NIL) (PROMPT " NO OBJECT SELECTED "))
);END WHILE LOP
(SETQ SLEN (CAR SLPS))
(IF (OR (= (CDR(ASSOC 0 (ENTGET SLEN))) "LWPOLYLINE") (= (CDR(ASSOC 0 (ENTGET SLEN))) "POLYLINE")) (SETQ LUP NIL) (PROMPT " OBJECT SELECTED NOT A POLYLINE "))
);END WHILE LUP
(SETQ ENTL (ENTGET SLEN))
(SETQ ND (CONS 1000 TDSD))
(SETQ ED '((-3 ("EDATA" (1000 . "SUB")) )) )
(SETQ EDS (CADAR ED))
(SETQ EDS2 (CAR ED))
(SETQ TDT (CAR (CDAR (CDAR ED))))
(SETQ NED (SUBST ND TDT EDS))
(SETQ NED (SUBST NED EDS EDS2))
(SETQ NED (SUBST NED EDS2 ED))
(REGAPP "EDATA")
(SETQ NED (APPEND ENTL NED))
(ENTMOD NED)
(REDRAW SLEN)
(SETQ SLPP (CADR SLPS))
(SETQ SLNPP (OSNAP SLPP "NEA"))
(COMMAND "BREAK" SLNPP "F" BP BP)
(SETQ SLEN (SSNAME (SSGET SLNPP) 0))
(SETQ SLLA (ASSOC 8 (ENTGET SLEN)))
(SETQ SLL (CDR SLLA))
(SETQ CL (GETVAR "CLAYER"))
(SETVAR "CLAYER" SLL)
(SETQ SMN (GETREAL "\nStarting station mark # <0>: "))
(IF (= SMN NIL) (SETQ SMN 0))
(INITGET "A D")
(SETQ NO (GETKWORD "\nDescend <Ascend>: "))
(IF (= NO NIL) (SETQ NO "A"))
(SETQ SL (GETDIST "\nStation segment length <50>: "))
(IF (= SL NIL) (SETQ SL 50.0))
(IF (= DWGSCALE NIL) (SETQ DWGSCALE 1.0))
(PROMPT "\nSymbol scale <")
(PRINC DWGSCALE )
(PROMPT ">: ")
(SETQ XS (GETDIST))
(IF (= XS NIL) (SETQ XS DWGSCALE))
(IF (/= XS NIL) (SETQ DWGSCALE XS))
(SETQ SLENL (ENTGET SLEN))
(SETQ EV1 (CDR(ASSOC 10 SLENL)))
(SETQ EVS EV1)
(SETQ SV 1)
(WHILE SV
(SETQ SLENL (CDR SLENL))
(SETQ EVT (ASSOC 10 SLENL))
(IF (/= EVT NIL) (SETQ EV2 (CDR EVT)) (SETQ SV NIL))
);END WHILE SV
(SETQ PEP1 EV1)
(SETQ PEP2 EV2)
(IF (> (DISTANCE SLNPP PEP2) (DISTANCE SLNPP PEP1)) (SETQ FIP PEP1) (SETQ FIP PEP2))
(COMMAND "INSERT" "MARK" FIP XS "" SLNPP)
(SETQ MARK (ENTLAST))
(COMMAND "REGENAUTO" "OFF")
(COMMAND "MEASURE" SLNPP "B" "MARK" "Y" SL)
(SETQ NMSS (SSLENGTH (SSGET "P")))
(SETQ PPL (LIST))
(FOREACH N ENTL
(PROGN
(SETQ PPA (CAR N))
(SETQ PPV (CDR N))
(IF (= PPA 10) (SETQ PPL (APPEND PPL (LIST PPV))))
));END N
(SETQ PPL2 (REVERSE PPL))
(SETQ ENTPT (CAR PPL))
(SETQ ENTPT2 (CAR PPL2))
(IF (> (DISTANCE FIP ENTPT) (DISTANCE FIP ENTPT2)) (PROGN (SETQ DBO 1) (SETQ ISMN 1)) (SETQ DBO 0))
(COMMAND "POINT" "@")
(SETQ DBF (ENTLAST))
(COMMAND "SETVAR" "ATTREQ" "0")
(SETQ LOOP 1)
(WHILE LOOP
(SETQ ELIST (ENTGET MARK))
(SETQ IP (CDR(ASSOC 10 ELIST)))
(SETQ RA (/ (* 180 (CDR(ASSOC 50 ELIST))) PI))
(SETQ RA (- RA (* (FIX (/ RA 360)) 360)))
(IF (AND (> RA 90) (< RA 270)) (SETQ RA (+ RA 180)))
(SETQ PM MARK)
(SETQ MARK (ENTNEXT MARK))
(COMMAND "ERASE" PM "")
(COMMAND "INSERT" "STMK" IP XS "" RA)
(SETQ STMKEN (ENTLAST))
(SETQ ENTL (ENTGET STMKEN))
(SETQ ND (CONS 1000 TDSD))
(SETQ ED '((-3 ("EDATA" (1000 . "SUB")) )) )
(SETQ EDS (CADAR ED))
(SETQ EDS2 (CAR ED))
(SETQ TDT (CAR (CDAR (CDAR ED))))
(SETQ NED (SUBST ND TDT EDS))
(SETQ NED (SUBST NED EDS EDS2))
(SETQ NED (SUBST NED EDS2 ED))
(REGAPP "EDATA")
(SETQ NED (APPEND ENTL NED))
(ENTMOD NED)
(REDRAW STMKEN)
(IF (= LU 2)
(PROGN
(SETQ SMSP (FIX (/ SMN 100)))
(SETQ SMSS (- SMN (* SMSP 100)))
));END PROGN/IF LU
(IF (< SMSP 0) (SETQ SMSP (* -1 SMSP)))
(IF (< SMSS 0) (SETQ SMSS (* -1 SMSS)))
(IF (= SMSS 0) (SETQ SMSS "00") (SETQ SMSS (RTOS SMSS LU 0)))
(IF (= SMSP 0 ) (SETQ SMSP "0") (SETQ SMSP (RTOS SMSP LU 0)))
(SETQ SMS (STRCAT SMSP "+" SMSS ))
(COMMAND "ATTEDIT" "N" "N" "STMK" "STMK" "STMK" "STMK" SMS)
(IF (AND (= ISMN 1) (= NO "A")) (PROGN (SETQ SMN (+ (+ (* NMSS SL) SMN) SL)) (SETQ ISMN 0)))
(IF (AND (= ISMN 1) (= NO "D")) (PROGN (SETQ SMN (- SMN (+ (* NMSS SL) SL))) (SETQ ISMN 0)))
(IF (AND (= DBO 1) (= NO "A")) (SETQ SMN (- SMN SL)))
(IF (AND (= DBO 0) (= NO "A")) (SETQ SMN (+ SMN SL)))
(IF (AND (= DBO 1) (= NO "D")) (SETQ SMN (+ SMN SL)))
(IF (AND (= DBO 0) (= NO "D")) (SETQ SMN (- SMN SL)))
(IF (= (CDR(ASSOC 0 (ENTGET MARK))) "POINT") (SETQ LOOP NIL))
);END WHILE
(SETQ JC1 (MAPCAR '+ BP '(0.01 0.01 0.0) ))
(SETQ JC2 (MAPCAR '- BP '(0.01 0.01 0.0) ))
;(SETQ FLTR (LIST '(-4 . "<AND") SLLA '(0 . "LWPOLYLINE") '(-4 . "AND>")))
;(SETQ JS (SSGET "C" JC1 JC2 FLTR))
;(COMMAND "PEDIT" SLEN "J" JS "" "X")
(COMMAND "SETVAR" "ATTREQ" "1")
(COMMAND "REGENAUTO" "ON")
(COMMAND "ERASE" DBF "")
(SETVAR "CLAYER" CL)
(setvar "osmode" osm)
(SETVAR "CMDECHO" CMDE)
(PRINC)
);END STA