Stationing Autolisp routine

[022803que]

Hey, I'm new to installing lisp, and do not see a command to load the original attachments. I saved all the attachments to a file, that my AutoCAD support path can reach. I just can not figure out what command to use, to load the lsp. I know it is in the right place, I just don't know how to make the program utilize it.

What do you enter in the command line, to make the program access the lsp?

Thanks,

[aaronic_abacus]

use the appload command.
also make sure the dwg files are in the search path.

[BlackBox]

Boo Startup Suite, hooray Autoloader (2012+)!

[aaronic_abacus]

;He's my current version...

(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

;look at the STA.LSP attachment for the second half

[aaronic_abacus]

; ok here's the second half(in attached above in STA.LSP)

(DEFUN C:STAE (/ 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 CMDE (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(setq osm (getvar "osmode"))
(command "osnap" "off")
(SETQ DBO 0)
(SETQ ISMN 0)
(SETQ NO NIL)
(PROMPT "*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
(SETQ LOP 1)
(WHILE LOP
(COMMAND "ZOOM" "C" BP "1.0")
(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 (GETREAL "\nStation segment length <50>: "))
(IF (= SL NIL) (SETQ SL 50.0))
(IF (= DWGSCALE NIL) (SETQ DWGSCALE 12.0))
(PROMPT "\nSymbol scale <")
(PRINC DWGSCALE )
(PROMPT ">: ")
(SETQ XS (GETREAL))
(IF (= XS NIL) (SETQ XS DWGSCALE))
(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 12))
(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)
(SETQ SMSP (FIX (/ SMN 100)))
(SETQ SMSS (- SMN (* SMSP 100)))
(IF (< SMSP 0) (SETQ SMSP (* -1 SMSP)))
(IF (< SMSS 0) (SETQ SMSS (* -1 SMSS)))
(IF (= SMSS 0) (SETQ SMSS "00") (SETQ SMSS (RTOS SMSS 2 0)))
(SETQ SMSP (RTOS SMSP 2 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 SM

[tfleming787716]

I'm relatively new to LISP Routines and I have been searching for a routine that will do stationing at 100' increments. Your routine works perfectly for that. I was wondering how it could be changed to do 2 things.
1. Make the stationing text Perpendicular to the polyline instead of Parallel.
2. Add lines that will also place a station mark on a point that intersects the polyline. (ie a telephone pole) as in the snip below:
snip of polyline.png


Any Help at all would be greatly appreciated! Ill be trying to figure it out on my own but could really use the extra brain.

Thanks!!

[aaronic_abacus]

Attached are the full set of Station Pack files.

[tfleming787716]

Attached are the full set of Station Pack files.

Thanks, One question though, when I ran the STA file it placed the station marks at 100 ft intervals and labeled them the file labeled the 100 ft station marks and then the poles as Numbers 1 thru 6. Is there a file in this folder that will allow a station mark to be placed on each of these poles with the correct footage for each? and will any of these files turn the station mark number so that it is perpendicular to the polyline? Appreciate the help!!

[aaronic_abacus]

STA is designed to station off a centerline or survey line.
LLSO will label station and offset along the station line.


(just added the menu in the above zip file)

[gilgameshhhhy]

Hey man, I was wondering if there is a way to make your stationing be 0+000 instead of 0+00. Thanks!