See the top rated post in this thread. Click here

Results 1 to 2 of 2

Thread: This stationing routine works fine for autocad 2002 but not in autocad 2014?

  1. #1
    I could stop if I wanted to
    Join Date
    2006-04
    Posts
    466
    Login to Give a bone
    0

    Default This stationing routine works fine for autocad 2002 but not in autocad 2014?

    ;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
    Attached Files Attached Files
    Last edited by aaronic_abacus; 2016-05-06 at 09:12 AM.

  2. #2
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,137
    Login to Give a bone
    0

    Default Re: This stationing routine works fine for autocad 2002 but not in autocad 2014?

    Typically, older AutoLISP routines work in 2014 with little modification. Have you seen the links in BlackBox's signature? He has provided an excellent explanation on resolving these problems with 2014 and newer.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

Similar Threads

  1. Updating a simple lisp routine to Autocad 2014
    By Danoposada320107 in forum AutoLISP
    Replies: 6
    Last Post: 2014-01-02, 10:53 PM
  2. Replies: 4
    Last Post: 2013-06-21, 09:46 PM
  3. Replies: 2
    Last Post: 2008-10-03, 05:12 PM
  4. works fine
    By xiqx in forum New Forum Users (Non technical)
    Replies: 3
    Last Post: 2007-02-13, 05:30 PM
  5. Replies: 1
    Last Post: 2007-02-07, 09:33 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
  •