Reverse Curve Lisp

Discussion in 'AutoCAD' started by Clarence, Nov 16, 2004.

  1. Clarence

    Clarence Guest

    I wrote this as an easier way to create Reverse Curves.
    But it isn't completely automated and can be difficult to use, thence making it "not so easy after all". Being the programmer, I can work my way through it, but others find it near impossible. Can someone give me some hints or suggestions to improve my command? I work for a Civil Engineering Firm that uses reverse curves regularly for Arterial Street Improvements. I never knew, until now, that turning lane configurations can be so tedious.
    Thank you!

    (defun c:rcc ( / )
    (setq blinxl xllinb)
    (setq xlfdpt perp2)
    (setq ptxlof xlopt)
    (setq offrvc rvcoff)
    (SETQ RVCPT CENPT)
    (SETQ CENRAD RVCCEN)
    (prompt "\nReverse Curve Creator.....")
    (setq addpick (getvar "pickadd"))
    (SETQ RVCOSM (GETVAR "OSMODE"))
    (setq RVCLAYR (getvar "clayer"))
    (setvar "pickadd" 1)
    (SETVAR "OSMODE" 33)
    (setq RVCNAM (getstring "\nEnter the Layer State Name to save: "))
    (command "-layer" "a" "s" RVCNAM "" "" "")
    (graphscr)
    (c:Lnstk)
    (princ)
    )
    (defun c:Lnstk ( / )
    (command "-layer" "n" "temp" "s" "temp" "" "")
    (SETQ RVCCEN
    (GETreal
    "\nEnter Stacking Length (Default hit enter key): "
    )
    )
    (if (= RVCCEN nil)
    (setq RVCCEN CENRAD)
    )
    (prompt
    "\nPick Stacking Start Point <endpoint of line dividing traffic> (Default hit enter key)..."
    )
    (SETQ CENPT (GETPOINT))
    (if (= CENPT nil)
    (setq CENPT RVCPT)
    )
    (COMMAND "CIRCLE" CENPT RVCCEN)
    (c:Mrkoff)
    (princ)
    )
    (defun c:Mrkoff ( / )
    (command "-layer" "n" "construct" "s" "construct" "" "")
    (PROMPT
    "\n***Offset Note: Line 1 divides traffic & Line 2 separates turning lane***"
    )
    (PROMPT
    "\n***Zoom out so that you can see Where you are offsetting to.***")
    (setq rvcoff (getreal
    "\nOffset Distance <equal to radius of rev. curve> (Default hit enter key): "
    )
    )
    (if (= rvcoff nil)
    (setq rvcoff offrvc)
    )
    (PROMPT "\nSelect Line 1 & Offset Toward Line 2...")
    (command "offset" rvcoff pause pause "")
    (SETQ rvc1 (SSGET "l"))
    (command "chprop" rvc1 "" "la" "construct" "")
    (PROMPT "\nSelect Line 2 & Offset Toward Line 1")
    (command "offset" rvcoff pause pause "")
    (SETQ rvc2 (SSGET "l"))
    (command "chprop" rvc2 "" "la" "construct" "")
    (c:Conlin)
    (princ)
    )
    (defun c:Conlin ( / )
    (prompt
    "\nPick End of Stacking (circle intersects Line 1)"
    )
    (command "-layer" "n" "trimby" "s" "trimby" "" "")
    (setvar "osmode" 160)
    (SETQ RVCXL (GETPOINT))
    (prompt
    "\nPick Centerline & then Extend to Offset Line 1..."
    )
    (SETQ xlcur (GETPOINT))
    (command "line" RVCXL xlcur "")
    (SETQ vertcon (SSGET "l"))
    (c:Laycon)
    (princ)
    )
    (defun c:Laycon ( / )
    (command "-layer" "s" "temp" "f" "*" "" "")
    (command "erase" "ALL" "")
    (COMMAND "-LAYER" "T" "*" "" "")
    (command "-layer" "s" "construct" "" "")
    (command "-purge" "la" "temp" "n" "")
    (prompt "\nZoom In Close........")
    (command "extend" rvc1 "" pause "")
    (setvar "osmode" 33)
    (prompt
    "\nPick Intersect of Extended Line & Offset Line 1 (Default hit enter key)..."
    )
    (SETQ xlopt (GETPOINT))
    (if (= xloPT nil)
    (setq xloPT ptxlof)
    )
    (setq rvcrad (* rvcoff 2))
    (COMMAND "CIRCLE" xloPT rvcrad)
    (c:Lincir)
    (princ)
    )
    (defun c:Lincir ( / )
    (command "-layer" "s" "trimby" "" "")
    (prompt
    "\nPick Intersect of New Circle & Offset Line 2 (Default hit enter key)..."
    )
    (SETQ perp2 (GETPOINT))
    (if (= perp2 nil)
    (setq perp2 xlfdpt)
    )
    (command "LINE" xlopt perp2 "")
    (SETQ angcon (SSGET "l"))
    (C:Finln)
    (princ)
    )
    (defun c:Finln ( / )
    (prompt "\nPick Line 2 (Default hit enter key)...")
    (setvar "osmode" 160)
    (SETQ xllinb (GETPOINT))
    (if (= xllinb nil)
    (setq xllinb blinxl)
    )
    (command "LINE" perp2 xllinb "")
    (SETQ conver (SSGET "l"))
    (c:Currev)
    (princ)
    )
    (defun c:Currev ( / )
    (setvar "clayer" RVCLAYR)
    (setvar "osmode" 33)
    (COMMAND "CIRCLE" xlopt rvcoff)
    (SETQ trimcirc (SSGET "l"))
    (COMMAND "CIRCLE" perp2 rvcoff)
    (SETQ cirtrim (SSGET "l"))
    (c:Layclean)
    (princ)
    )
    (defun c:Layclean ( / )
    (command "-layer" "s" "construct" "f" "*" "" "")
    (command "erase" "all" "")
    (command "-layer" "t" "*" "" "")
    (setvar "clayer" RVCLAYR)
    (command "-purge" "la" "construct" "n")
    (prompt "\nTrim Turn Lane Entrance...")
    (command "trim" vertcon angcon conver "" trimcirc cirtrim "")
    (prompt "\nSelect Line 2 <pick at area to trim out for opening>...")
    (SETQ mrkopen (SSGET))
    (command "trim" vertcon conver "" mrkopen "")
    (command "-layer" "s" "trimby" "f" "*" "" "")
    (command "erase" "all" "")
    (command "-layer" "t" "*" "" "")
    (setvar "clayer" RVCLAYR)
    (command "-purge" "la" "trimby" "n")
    (command "-layer" "a" "r" RVCNAM "D" RVCNAM "" "" "")
    (SETVAR "OSMODE" rvcosm)
    (setvar "pickadd" addpick)
    (princ)
    )
     
    Clarence, Nov 16, 2004
    #1
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.