Autolisp program to label station and offset.

;Autolisp program to label station and offset.

;this program is in conjunction with STA.lsp (see attached)

;this utility is for plan view

Code:

---


(DEFUN C:LLSO ()
 (SETQ LUG (GETVAR "LUNITS"))
 (IF (= LUG 2) (C:LLSOD))
 (IF (OR (= LUG 3) (= LUG 4)) (C:LLSOE))
);END LLSO


(DEFUN C:LLSOD ()
(SETQ CMDE (GETVAR "CMDECHO"))
(setq osm (getvar "osmode"))
(command "osnap" "off")
(SETVAR "CMDECHO" 0)
(SETVAR "ATTREQ" 0)
(COMMAND "REGENAUTO" "OFF")
(PROMPT "\n*LABEL LOCATION STATION OFFSET*")
(SETQ EIP (GETPOINT "\nPick point: "))
(SETQ CL NIL)
(WHILE (NOT CL)
(SETQ CL (ENTSEL "\nSelect station line: ")
);END WHILE
(SETQ ENTL (ENTGET (CAR CL)))
(SETQ ENTPT (CDR CL))
(SETQ EDATAL (ENTGET (CAR CL) '("EDATA")))
(SETQ EDBNS (ASSOC -3 EDATAL))
(SETQ EDBN (CDR (CADAR (CDR EDBNS))))
(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 FVP (CAR (CDR CL)))
(SETQ CTD 10000000)
(COMMAND "LINE" EIP "PER" FVP "")
(SETQ PL (ENTLAST))
(SETQ PLL (ENTGET PL))
(COMMAND "ERASE" PL "")
(SETQ LIP (CDR (ASSOC 11 PLL)))
(SETQ PTD (DISTANCE EIP LIP))
(IF (< PTD CTD) (PROGN (SETQ CTD PTD) (SETQ CCE CLE) (SETQ CIP LIP) ))
(SETQ CLE CCE)
(SETQ LIP CIP)
(SETQ PLA (ANGLE LIP EIP))
(SETQ EWP1 (POLAR LIP (+ PLA (/ PI 4)) 3000))
(SETQ EWP2 (POLAR LIP (+ PI (+ PLA (/ PI 4))) 3000))
(SETQ RMN (CONS 50   
 (- PLA (- (/ PI 2) (/ PI 10)))))
(SETQ RMX (CONS 50   
 (- PLA (+ (/ PI 2) (/ PI 10)))))
(SETQ FMN (CONS 50 
 (+ (- PLA (- (/ PI 2) (/ PI 10))) PI)))
(SETQ FMX (CONS 50 
 (+ (- PLA (+ (/ PI 2) (/ PI 10))) PI)))
(SETQ FTL '(
            (2 . "STMK")
            (-4 . "<AND")
            (-4 . "<NOT")
              (-4 . "<AND")
              (-4 . ">")
              (99 . "XX")
              (-4 . "<")
              (98 . "XX")
              (-4 . "AND>")
            (-4 . "NOT>")
            (-4 . "<NOT")
              (-4 . "<AND")
              (-4 . ">")
              (97 . "XX")
              (-4 . "<")
              (96 . "XX")
              (-4 . "AND>")
            (-4 . "NOT>")
            (-4 . "AND>")
          ))     
(SETQ FTL (SUBST RMN '(99 . "XX") FTL))
(SETQ FTL (SUBST RMX '(98 . "XX") FTL))
(SETQ FTL (SUBST FMN '(97 . "XX") FTL))
(SETQ FTL (SUBST FMX '(96 . "XX") FTL))
(SETQ SMS (SSGET "X" FTL))
(SETQ SMSL (SSLENGTH SMS))
(SETQ CT3 (- SMSL 1))
(SETQ CSMD 1000000)
(SETQ LP3 1)
(WHILE LP3
(SETQ SME (SSNAME SMS CT3))
(SETQ SMEL (ENTGET SME '("EDATA")))
(SETQ EDBNS (ASSOC -3 SMEL))
(SETQ SMELBN (CDR (CADAR (CDR EDBNS))))
(IF (= SMELBN EDBN) (SETQ EDBNTM 1) (SETQ EDBNTM 0))
(SETQ SMIP (CDR (ASSOC 10 SMEL)))
(SETQ SMR (CDR (ASSOC 50 SMEL)))
(SETQ SMD (DISTANCE SMIP LIP))
(IF (AND (< SMD CSMD) (= EDBNTM 1)) (PROGN (SETQ CSMD SMD) (SETQ SMIPP SMIP) (SETQ SMEP SME)))
(SETQ CT3 (- CT3 1))
(IF (< CT3 0) (SETQ LP3 NIL))
);END LP3
(SETQ SMEAL (ENTGET (ENTNEXT SMEP)))
(SETQ SMEAA (CDR (ASSOC 1 SMEAL)))
(SETQ CT3 (- SMSL 2))
(SETQ SMS2 (SSDEL SMEP SMS))
(SETQ CSMD2 100000)
(SETQ LP3 1)
(WHILE LP3
(SETQ SME2 (SSNAME SMS2 CT3))
(SETQ SME2L (ENTGET SME2 '("EDATA")))
(SETQ EDBNS (ASSOC -3 SME2L))
(SETQ SMELBN (CDR (CADAR (CDR EDBNS))))
(IF (= SMELBN EDBN) (SETQ EDBNTM 1) (SETQ EDBNTM 0))
(SETQ SMIP2 (CDR (ASSOC 10 SME2L)))
(SETQ SMR2 (CDR (ASSOC 50 SME2L)))
(SETQ SMD2 (DISTANCE SMIP2 LIP))
(IF (AND (< SMD2 CSMD2) (= EDBNTM 1)) (PROGN (SETQ CSMD2 SMD2) (SETQ SMIPP2 SMIP2) (SETQ SMEP2 SME2)))
(SETQ CT3 (- CT3 1))
(IF (< CT3 0) (SETQ LP3 NIL))
);END LP3
(SETQ SMEAL2 (ENTGET (ENTNEXT SMEP2)))
(SETQ SMEAA2 (CDR (ASSOC 1 SMEAL2)))
(SETQ CT4 1)
(SETQ LP4 1)
(WHILE LP4
(SETQ ST (SUBSTR SMEAA CT4 1))
(IF (= ST "+") (SETQ LP4 NIL) (SETQ CT4 (+ CT4 1)) )
);END WHILE LP4
(SETQ AT1 (STRCAT (SUBSTR SMEAA 1 (- CT4 1)) (SUBSTR SMEAA (+ CT4 1)) ))
(SETQ ATV (DISTOF AT1 2))
(SETQ CT5 1)
(SETQ LP5 1)
(WHILE LP5
(SETQ ST (SUBSTR SMEAA2 CT5 1))
(IF (= ST "+") (SETQ LP5 NIL) (SETQ CT5 (+ CT5 1)) )
);END WHILE LP5
(SETQ AT2 (STRCAT (SUBSTR SMEAA2 1 (- CT5 1)) (SUBSTR SMEAA2 (+ CT5 1)) ))
(SETQ ATV2 (DISTOF AT2 2))
(IF (< ATV ATV2) (SETQ NTV (+ ATV  (/ CSMD 1))) (SETQ NTV (- ATV (/ CSMD 1))) )
(SETQ NSN (FIX NTV))
(SETQ NSNP (/ NSN 100))
(SETQ NSSP (ITOA NSNP))
(SETQ NSNS (- NSN (* NSNP 100)))
(SETQ NSSS (ITOA NSNS))
(IF (< NSNS 10) (SETQ NSSS (STRCAT "0" NSSS)))
(SETQ NST (STRCAT NSSP "+" NSSS))
(SETQ OFF (DISTANCE EIP LIP))
(SETQ OFT (RTOS OFF))
(SETQ SDA (/ (* (ANGLE LIP EIP) 180) PI))
(IF (AND (<= SDA 180) (>= SDA 0)) (SETQ FLGN "LL") (SETQ FLGN "LL2"))
(SETQ LIP SDA);TEST
(COMMAND "INSERT" FLGN EIP XS "" (+ SDA 180))
(SETQ FLG (ENTLAST))
(COMMAND "ATTEDIT" "N" "N" "LL*" "" "XX'" "XX'" OFT)
(COMMAND "ATTEDIT" "N" "N" "LL*" "" "X+XX" "X+XX" NST)
(SETVAR "ATTREQ" 1)
(COMMAND "REGENAUTO" "ON")
)
(setvar "osmode" osm)
(SETVAR "CMDECHO" CMDE)
(PRINC)
);END LLSO





(DEFUN C:LLSOE ()
(SETQ CMDE (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(setq osm (getvar "osmode"))
(command "osnap" "off")
(SETVAR "ATTREQ" 0)
(COMMAND "REGENAUTO" "OFF")
(PROMPT "\n*LABEL LOCATION STATION OFFSET*")
(SETQ EIP (GETPOINT "\nPick point: "))
(SETQ CL NIL)
(WHILE (NOT CL)
(SETQ CL (ENTSEL "\nSelect station line: ")
);END WHILE
(SETQ ENTL (ENTGET (CAR CL)))
(SETQ ENTPT (CDR CL))
(SETQ EDATAL (ENTGET (CAR CL) '("EDATA")))
(SETQ EDBNS (ASSOC -3 EDATAL))
(SETQ EDBN (CDR (CADAR (CDR EDBNS))))
(IF (= DWGSCALE NIL) (SETQ DWGSCALE 12.0))
(PROMPT "\nSymbol scale <")
(PRINC DWGSCALE )
(PROMPT ">: ")
(SETQ XS (GETDIST))
(IF (= XS NIL) (SETQ XS DWGSCALE))
(IF (/= XS NIL) (SETQ DWGSCALE XS))
(SETQ FVP (CAR (CDR CL)))
(SETQ CTD 10000000)
(COMMAND "LINE" EIP "PER" FVP "")
(SETQ PL (ENTLAST))
(SETQ PLL (ENTGET PL))
(COMMAND "ERASE" PL "")
(SETQ LIP (CDR (ASSOC 11 PLL)))
(SETQ PTD (DISTANCE EIP LIP))
(IF (< PTD CTD) (PROGN (SETQ CTD PTD) (SETQ CCE CLE) (SETQ CIP LIP) ))
(SETQ CLE CCE)
(SETQ LIP CIP)
(SETQ PLA (ANGLE LIP EIP))
(SETQ EWP1 (POLAR LIP (+ PLA (/ PI 4)) 3000))
(SETQ EWP2 (POLAR LIP (+ PI (+ PLA (/ PI 4))) 3000))
(SETQ RMN (CONS 50   
 (- PLA (- (/ PI 2) (/ PI 10)))))
(SETQ RMX (CONS 50   
 (- PLA (+ (/ PI 2) (/ PI 10)))))
(SETQ FMN (CONS 50 
 (+ (- PLA (- (/ PI 2) (/ PI 10))) PI)))
(SETQ FMX (CONS 50 
 (+ (- PLA (+ (/ PI 2) (/ PI 10))) PI)))
(SETQ FTL '(
            (2 . "STMK")
            (-4 . "<AND")
            (-4 . "<NOT")
              (-4 . "<AND")
              (-4 . ">")
              (99 . "XX")
              (-4 . "<")
              (98 . "XX")
              (-4 . "AND>")
            (-4 . "NOT>")
            (-4 . "<NOT")
              (-4 . "<AND")
              (-4 . ">")
              (97 . "XX")
              (-4 . "<")
              (96 . "XX")
              (-4 . "AND>")
            (-4 . "NOT>")
            (-4 . "AND>")
          ))     
(SETQ FTL (SUBST RMN '(99 . "XX") FTL))
(SETQ FTL (SUBST RMX '(98 . "XX") FTL))
(SETQ FTL (SUBST FMN '(97 . "XX") FTL))
(SETQ FTL (SUBST FMX '(96 . "XX") FTL))
(SETQ SMS (SSGET "X" FTL))
(SETQ SMSL (SSLENGTH SMS))
(SETQ CT3 (- SMSL 1))
(SETQ CSMD 1000000)
(SETQ LP3 1)
(WHILE LP3
(SETQ SME (SSNAME SMS CT3))
(SETQ SMEL (ENTGET SME '("EDATA")))
(SETQ EDBNS (ASSOC -3 SMEL))
(SETQ SMELBN (CDR (CADAR (CDR EDBNS))))
(IF (= SMELBN EDBN) (SETQ EDBNTM 1) (SETQ EDBNTM 0))
(SETQ SMIP (CDR (ASSOC 10 SMEL)))
(SETQ SMR (CDR (ASSOC 50 SMEL)))
(SETQ SMD (DISTANCE SMIP LIP))
(IF (AND (< SMD CSMD) (= EDBNTM 1)) (PROGN (SETQ CSMD SMD) (SETQ SMIPP SMIP) (SETQ SMEP SME)))
(SETQ CT3 (- CT3 1))
(IF (< CT3 0) (SETQ LP3 NIL))
);END LP3
(SETQ SMEAL (ENTGET (ENTNEXT SMEP)))
(SETQ SMEAA (CDR (ASSOC 1 SMEAL)))
(SETQ CT3 (- SMSL 2))
(SETQ SMS2 (SSDEL SMEP SMS))
(SETQ CSMD2 100000)
(SETQ LP3 1)
(WHILE LP3
(SETQ SME2 (SSNAME SMS2 CT3))
(SETQ SME2L (ENTGET SME2 '("EDATA")))
(SETQ EDBNS (ASSOC -3 SME2L))
(SETQ SMELBN (CDR (CADAR (CDR EDBNS))))
(IF (= SMELBN EDBN) (SETQ EDBNTM 1) (SETQ EDBNTM 0))
(SETQ SMIP2 (CDR (ASSOC 10 SME2L)))
(SETQ SMR2 (CDR (ASSOC 50 SME2L)))
(SETQ SMD2 (DISTANCE SMIP2 LIP))
(IF (AND (< SMD2 CSMD2) (= EDBNTM 1)) (PROGN (SETQ CSMD2 SMD2) (SETQ SMIPP2 SMIP2) (SETQ SMEP2 SME2)))
(SETQ CT3 (- CT3 1))
(IF (< CT3 0) (SETQ LP3 NIL))
);END LP3
(SETQ SMEAL2 (ENTGET (ENTNEXT SMEP2)))
(SETQ SMEAA2 (CDR (ASSOC 1 SMEAL2)))
(SETQ CT4 1)
(SETQ LP4 1)
(WHILE LP4
(SETQ ST (SUBSTR SMEAA CT4 1))
(IF (= ST "+") (SETQ LP4 NIL) (SETQ CT4 (+ CT4 1)) )
);END WHILE LP4
(SETQ AT1 (STRCAT (SUBSTR SMEAA 1 (- CT4 1)) (SUBSTR SMEAA (+ CT4 1)) ))
(SETQ ATV (DISTOF AT1 2))
(SETQ CT5 1)
(SETQ LP5 1)
(WHILE LP5
(SETQ ST (SUBSTR SMEAA2 CT5 1))
(IF (= ST "+") (SETQ LP5 NIL) (SETQ CT5 (+ CT5 1)) )
);END WHILE LP5
(SETQ AT2 (STRCAT (SUBSTR SMEAA2 1 (- CT5 1)) (SUBSTR SMEAA2 (+ CT5 1)) ))
(SETQ ATV2 (DISTOF AT2 2))
(IF (< ATV ATV2) (SETQ NTV (+ ATV  (/ CSMD 12))) (SETQ NTV (- ATV (/ CSMD 12))) )
(SETQ NSN (FIX NTV))
(SETQ NSNP (/ NSN 100))
(SETQ NSSP (ITOA NSNP))
(SETQ NSNS (- NSN (* NSNP 100)))
(SETQ NSSS (ITOA NSNS))
(IF (< NSNS 10) (SETQ NSSS (STRCAT "0" NSSS)))
(SETQ NST (STRCAT NSSP "+" NSSS))
(SETQ OFD (FIX (DISTANCE EIP LIP)))
(SETQ OFF (* (FIX (/ OFD 12)) 12))
(SETQ OFI (- OFD OFF))
(IF (> OFI 5) (SETQ OFF (+ OFF 12)))
(SETQ OFT (RTOS OFF))
(SETQ SDA (/ (* (ANGLE LIP EIP) 180) PI))
(IF (AND (<= SDA 180) (>= SDA 0)) (SETQ FLGN "LL") (SETQ FLGN "LL2"))
(COMMAND "INSERT" FLGN EIP XS "" LIP)
(SETQ FLG (ENTLAST))
(COMMAND "ATTEDIT" "N" "N" "LL*" "" "XX'" "XX'" OFT)
(COMMAND "ATTEDIT" "N" "N" "LL*" "" "X+XX" "X+XX" NST)
(SETVAR "ATTREQ" 1)
(COMMAND "REGENAUTO" "ON")
)
(setvar "osmode" osm)
(SETVAR "CMDECHO" CMDE)
(PRINC)
);END LL

---

The station.lsp refers to a "mark" block. Could you let me know what it is supposed to contain (there is no mark.dwg available for download)?

Thanks.

I edited the thread to include MARK.DWG(attached above).

I added another station and offset routine EXM.LSP(above post) which uses station mark extensions for marking utility systems.

What command do I enter to load this lsp? I'm use to classroom setting, where they come with a .txt file that gives instructions on how to utilize the shortcuts.

Yes, I saved the attachments to a support file that my CAD can access, I just don't know how to make CAD utilize the lsp.

after loading all the lisp files.
create a station line using station.
then use LLSO to create station and offset labels and EXM to label a run allong a station line.

Ok, after 7000 views I thought i'd give the current version.

Your welcome to use these they are library routines where you would use a getkeyword or initget use Multi radio buttons.lsp for entry like getreal, getstring use multi getvals.lsp.

They will make a temporary dcl that you can use in any code both are limited to screen size as far as I could test. I am working on a new librarygetvals and multi radio combo. Have a working version. Also getvals with image. Check Cadtutor downloads for updates.