Search the Community

I found a lisp routine to make a 2d railroad track but it has some errors in it and I know nothing about writing lisp routines and so I cannot figure out where the errors are or how to fix them. I am using Civil3d 2012. Thanks for any help on this. Here is the code: ;Create a railroad line from a defined centerline drawn as a polyline (defun C:rrtrax ( / curlyr rr-cl rrlyr oldosnap rt lt e ename etype nent tent osdone entstart cntr bulge rtoff ltoff startpt TblLst bss blname lyrcount) (defun myerror (s) ; If an error (such as ESC or invalid selection) occurs ; while this command is active... (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (setvar "osmode" oldosnap) (command "_layer" "s" curlyr "") ; Restore saved modes (setq *error* olderr) ; Restore old *error* handler (princ) ) (command "undo" "begin" ) (setq olderr *error* *error* myerror) (setq oldosnap (getvar "osmode")) (if (< oldosnap 16384)(setvar "osmode" (+ 16384 oldosnap))) (setq curlyr (getvar "clayer")) (setq rrlyr "1-RR-TRACK") (setq rrcl "rr-cl") (if (= (tblsearch "layer" rrlyr) nil) (command "_layer" "n" rrlyr "c" "12" rrlyr "s" rrlyr "") (command "_layer" "T" rrlyr "on" rrlyr "s" rrlyr "") ) (if (= (tblsearch "layer" rrcl) nil) (command "_layer" "n" rrcl "") (command "_layer" "T" rrcl "on" rrcl "") ) (defun osline () (setq rt (polar entstart (+ (angle entstart entend) (/ pi 2)) 1.0) lt (polar entstart (- (angle entstart entend) (/ pi 2)) 1.0) ) (doos rt lt) ) ;end osline (defun osarc () (setq rt (polar entstart (angle entstart cntr) 1.0) lt (polar entstart (angle cntr entstart) 1.0) ) (doos rt lt) ) ;end osarc (defun dopoly () (setq osdone nil ename (entnext ename) tent (entget ename) nent (entget (entnext ename)) ) (while (/= "SEQEND" (cdr (assoc 0 nent))) (setq entstart (cdr (assoc 10 tent)) entend (cdr (assoc 10 nent)) bulge (cdr (assoc 42 tent)) ) (if (= bulge 0.0) (drawline) (drawarc) ) (setq ename (entnext ename) tent (entget ename) nent (entget (entnext ename)) ) ) );end dopoly (defun drawline () (if (= osdone nil) (progn (osline) (setq startpt entstart) ) ) ) (defun drawarc () (if (= osdone nil) (progn (osarc) (setq startpt entstart) ) ) ) (defun doos (rt lt) (command "_offset" (/ rr_w 2) e rt "") (command "_change" "l" "" "p" "la" rrlyr "") (setq rtoff (entlast)) (command "_offset" (/ rr_w 2) e lt "") (command "_change" "l" "" "P" "LA" rrlyr "") (setq ltoff (entlast)) (setq osdone t) ) ;end doos ;Make block if needed (defun makebl () (entmake '((0 . "BLOCK") (2 . "rr-tie") (8 . "1-RR-TRACK") (70 . 0) (10 0.333 3.354 0) ) ) (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "1-RR-TRACK") (100 . "AcDbPolyline") (90 . 4) (10 0.00 0.00) (10 0.666 0.00) (10 0.666 6.708) (10 0.00 6.708) (70 . 129) ) ) (entmake '((0 . "ENDBLK"))) ) (defun GetFilterTable (Tbl Nme / CurTbl) (setq TblLst nil) (while (setq CurTbl (tblnext Tbl (not CurTbl))) (if (wcmatch (cdr (assoc 2 CurTbl)) Nme) (setq TblLst (cons CurTbl TblLst)) ) ) (reverse TblLst) ) (defun insblock () (setq bss (ssget "_X" '((2 . "rr-tie")))) (ssadd rtoff bss) (ssadd ltoff bss) (if (= (GetFilterTable "BLOCK" "TRACKS-*") nil) (setq blname "TRACKS-1") (progn (setq lyrcount (1+ (length TblLst))) (setq blname (strcat "TRACKS-" (rtos lyrcount))) ) );end if (command "_-block" blname startpt bss "") (command "_-insert" blname startpt 1 "" 0) ) (if (= rr_w nil)(setq rr_w 4.708)) (princ (strcat "\nDraws U.S. Standard <" (rtos rr_w) "'> railroad tracks.")) (setq e (entsel "\nPick a LWPolyline: ")) (while e (setq ename (car e) etype (cdr (assoc 0 (entget ename))) ) (if (or (= etype "POLYLINE")(= etype "LWPOLYLINE")) (progn (if (= etype "LWPOLYLINE") (progn (command "_convertpoly" "h" e "") (setq @poly T) ) ) (dopoly) (setq e2 e) (setq e nil) ) (setq e (entsel "\nYou must pick a POLYLINE - Try again")) ) ) ;Make Tie block if not exist (if (= (tblsearch "block" "rr-tie") nil) (makebl) );end block if (command "_measure" e2 "b" "rr-tie" "y" "3" ) (insblock) (command "_layer" "s" curlyr "") (setvar "osmode" oldosnap) (command "_change" e2 "" "P" "la" "rr-cl" "") (command "_layer" "off" "rr-cl" "") (setq bss (ssget "_x" '((2 . "rr-tie")))) (if (= @poly T) (command "convertpoly" "l" e2 "") ) (command "undo" "end" ) (princ) )