Results 1 to 8 of 8

Thread: Autolisp program to label station and offset.

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    I could stop if I wanted to aaronic_abacus's Avatar
    Join Date
    2006-04
    Posts
    419
    Login to Give a bone
    0

    Default 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
    Attached Files Attached Files
    Last edited by aaronic_abacus; 2017-06-12 at 01:26 AM. Reason: [CODE] tags added.

    http://www.watsonlisp.com

    Artificial Intelligence for AutoCAD
    Find detail drawings by text and attribute content!
    6000 lines of code and and in development since 1997.
    Say goodbye to detail books.

Similar Threads

  1. Replies: 6
    Last Post: 2014-09-20, 03:54 AM
  2. Station Offset Label Question
    By bryanf in forum AutoCAD Civil 3D - General
    Replies: 1
    Last Post: 2011-01-27, 12:45 PM
  3. Replies: 18
    Last Post: 2010-09-22, 09:21 PM
  4. Alignments - Label Station and Offset
    By todd.80290 in forum Land Desktop - General
    Replies: 4
    Last Post: 2009-12-10, 09:39 PM
  5. Label Station & Offset
    By td729 in forum AutoCAD Civil 3D - General
    Replies: 1
    Last Post: 2008-06-17, 04:55 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •