Jump to content

LISP FILE FOR HORIZONTAL CURVE

Harshad Bamania

By Harshad Bamania
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Harshad Bamania Newbie

Harshad Bamania

Posted
Posted

i'm trying to write proper code for the horizontal curve with proper transition and shifting of curve. but for some reason it is not working properly. please help me to find my mistakes.

 

  

; fillet 2 lines with arc & SPIRAL curves
; pcp maunsell adelaide nov 96ises extended entity data - application name "SPIRAL"
;
(defun *error* (msg)
   (princ msg)
   (princ)
)
(defun c:fspi(/ esel1 enam1 esel2 ep2 p3 p4 ip rad t1 t2 ipang h in rl c s s1 c1 rl1 in1 s2 c2 rl2 in2 sptype aa bb cc tang oang tanlen n l x y xl yl)

   (setq ts (getvar "textsize"))
   (setvar "cmdecho" 0)
   (command "undo" "group")
   (setq acol "6" scol "2")
   (while
      (not (setq esel1 (entsel "\nSelect first tangent:")))
   )
   (setq enam1 (car esel1))
   (redraw enam1 3)
   (if (= (cdr (assoc 0 (setq ent1 (entget enam1)))) "LINE")
      (progn
         (while
           
         (setq enam2 (car esel2))
         (redraw enam1 4)
         (redraw enam2 3)
         (if (= (cdr (assoc 0 (setq ent2 (entget enam2)))) "LINE")
            (progn
               (setq p1 (cdr (assoc 10 ent1)) p2 (cdr (assoc 11 ent1)))
               (setq p3 (cdr (assoc 10 ent2)) p4 (cdr (assoc 11 ent2)))
               (setq ip (inters p1 p2 p3 p4 nil))
               (if (not lrad) (setq lrad 100.0))
               (setq rad (getdist (strcat "\nCurve radii <" (rtos lrad 2 1) ">: ")))
               (if (not rad) (setq rad lrad) (setq lrad rad))
               (redraw enam2 4)
               (if (not lt1) (setq lt1 0.0))
               (setq t1 (getdist (strcat "\nLeading transition length <" (rtos lt1 2 1) ">: ")))
               (if (not t1) (setq t1 lt1) (setq lt1 t1))
               (if (not lt2) (setq lt2 0.0))
               (setq t2 (getdist (strcat "\nTrailing transition length <" (rtos lt2 2 1) ">: ")))
               (if (not t2) (setq t2 lt2) (setq lt2 t2))
               (if (> (distance p1 ip) (distance p2 ip)) (setq pa p1) (setq pa p2))
               (if (> p3 ip) (distance p4 ip)) (setq pc p3) (setq pc p4))
               (setq ipang (- (angle ip pc) (angle pa ip)))
               (if (>= (abs ipang) pi)
                  (if (minusp ipang) (setq ipang (+ ipang pi pi)) (setq ipang (- ipang (* pi 2))))
               )
               (if (minusp ipang) (setq h -1) (setq h 1))
               (setq ipang (abs (/ ipang 2.0)))
               (entdel (car esel1))
               (cs t1)
               (setq s1 s c1 c rl1 rl in1 in)
               (cs t2)
               (setq s2 s c2 c rl2 rl in2 in sptype 1)
               (spi t1 pa s1 s2 c1 in1 rl1)
               (setq p3 p2 sptype (- 1))
               (setq h (* h -1))
               (entdel (car esel2))
               (spi t2 pc s2 s1 c2 in2 rl2)
               (if (minusp h) (command "arc" p3 "e" p2 "r" rad) (command "arc" p2 "e" p3 "r" rad))
               (command "chprop" (entlast) "" "c" acol "")
;               (command "circle" p2 1.0)
;               (command "circle" p3 1.0)
            )
         )
      )
   )
   (command "undo" "end")
   (princ)
)
(defun cs (l)
   (if (> l 0)
      (progn
         (setq in (/ l (fix (/ l 2.0))))
         (setq rl (* rad l))
         (setq c (- (+ (- (/ l 2.0) (/ (expt l 3.0) (* 240 rad rad)))
            (/ (expt l 5.0) 34560.0 (expt rad 4.0)))
            (/ (expt l 7.0) expt rad 6.0)))
         )
         (setq s (+ (- (/ (* l l) 24.0 rad) (/ (expt l 4) 2688.0 (expt rad 3)))
            (- (/ (expt l 6) 506880.0 (expt rad 5)) (/ (expt l 8) 154828800.0 (expt rad 7))))
         )
      )
      (setq in 0 rl 0 c 0 s 0)
   )
)
(defun spi (l pt args1 args2 argc argin argrl)
;   (setq yl 0 xl 0)
   (setq aa (* rad (/ (sin ipang) (cos ipang)))
         bb (* args1 (/ (cos (* 2 ipang)) (sin (* 2 ipang))))
         cc (* args2 (/ 1.0 (sin (* 2 ipang))))
   )
   (setq tanlen (+ (- aa bb) cc argc))
   (setq p1 (polar ip (angle ip pt) tanlen) p2 p1)
   (if (> l 0)
      (progn
;         (command "circle" p1 1.0)
         (setq tang (angle pt ip))
         (setq oang (+ tang (/ pi 2.0)))
         (setq n argin)
         (if (not (regapp "SPIRAL")) (regapp "SPIRAL"))
         (setq xd_list (list '(1002 . "}")))
         (setq xd_list (cons (cons 1040 l) xd_list))
         (setq xd_list (cons (cons 1010 (list argrl tang h)) xd_list))
         (setq xd_list (cons (cons 1070 sptype) xd_list))
         (setq xd_list . "{") xd_list))
         (setq xd_list (cons "SPIRAL" xd_list))
         (entmake (list (cons 0 "POLYLINE") (cons 66 1) (cons -3 (list xd_list))))
         (entmake (list (cons 0 "VERTEX") (cons 10 p1) (cons -3 (list xd_list))))
         (setq xd_list (list '(1002 . "}")))
         (setq xd_list (cons (cons 1040 l) xd_list))
         (setq xd_list (cons (cons 1010 (list 0 0 0)) xd_list))
         (setq xd_list (cons (cons 1070 0) xd_list))
         (setq xd_list (cons '(1002 . "{") xd_list))
         (setq xd_list (cons "SPIRAL" xd_list))
         (repeat (fix (/ l n))
            (setq x
                (+ (- (+ (- n
               (/ (expt n 5.0) 40.0 argrl argrl))
               (/ (expt n 9.0) 3456.0 (expt argrl 4.0)))
               (/ (expt n 13.0) 599040.0 (expt argrl 6.0)))
               (/ (expt n 17.0) 175472640.0 (expt argrl 8.0)))
            )
            (setq y
                (* h (- (+ (-
               (/ (expt n 3.0) 6.0 argrl)
               (/  (expt argrl 3.0)))
               (/ (expt n 11.0) 42240.0 (expt argrl 5.0)))
               (/ (expt n 15.0) 9676800.0 (expt argrl 7.0))))
            )
            (setq p2 (polar p1 tang x))
            (setq p2 (polar p2 oang y))
;            (setq a (/ (atan (/ (- y yl) (- x xl))) 2))
;            (setq blg (* (/ (sin a) (cos a)) (- h)))
            (entmake (list () (cons 10 P2) (cons -3 (list xd_list))))
            (setq xl x yl y)
            (setq n (+ n argin))
         )
         (entmake (list (cons 0 "SEQEND")))
         (command "pedit" (entlast) "f" "x")
         (command "chprop" (entlast) ""  "")
      )
   )
   (command "line" pt p1 "")
)

 

Tsuky Community Regular

Tsuky

Posted
Posted

I can't correct your code, there are a lot of writing errors.
But I think I understand what you are talking about, so I suggest this which should make a transitional curve between a line and a circle.

clothoide.lsp idclo.lsp

  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted

In my 1980 road design handbook is the formula for transitions. So it would be best to post your reference before coding is done. 

ymg3 Rising Star

ymg3

Posted
Posted (edited)

Harshad,

 

I managed to make your code works.  However there is still a lot of problem in it with subroutine returning result as global variable.

Also not sure what you want to do with all this extended data.  The computation for x and y were all order of magnitude wrong.

 

I recommend you download this paper The Clothoid Computation: A Simple and Efficient Numerical Algorithm  by Mendez and Urcera

for a simpler computation of the clothoid.

Here is your code where I changed a s little as I could.  Also did not check if it works in every orientation.

 

ymg

  

;; fillet 2 lines with arc & SPIRAL curves
; pcp maunsell adelaide nov 96ises extended entity data - application name "SPIRAL"
;
(defun *error* (msg)
   (princ msg)
   (princ)
)
(defun c:fspi(/ esel1 enam1 esel2 ep2 p3 p4 ip rad t1 t2 ipang h in rl c s s1 c1 rl1 in1 s2 c2 rl2 in2 sptype aa bb cc tang oang tanlen n l x y xl yl)

   (setq ts (getvar "textsize"))
   (setvar "cmdecho" 0)
   (command "undo" "group")
   (setq acol "6" scol "2")
   (while
      (not (setq esel1 (entsel "\nSelect first tangent:")))
   )
   (setq enam1 (car esel1))
   (redraw enam1 3)
   (if (= (cdr (assoc 0 (setq ent1 (entget enam1)))) "LINE")
      (progn
         (while (not (setq esel2 (entsel "\nSelect second tangent:"))))           
         (setq enam2 (car esel2))
         (redraw enam1 4)
         (redraw enam2 3)
         (if (= (cdr (assoc 0 (setq ent2 (entget enam2)))) "LINE")
            (progn
               (setq p1 (cdr (assoc 10 ent1)) p2 (cdr (assoc 11 ent1)))
               (setq p3 (cdr (assoc 10 ent2)) p4 (cdr (assoc 11 ent2)))
               (setq ip (inters p1 p2 p3 p4 nil))
               (if (not lrad) (setq lrad 100.0))
               (setq rad (getdist (strcat "\nCurve radii <" (rtos lrad 2 1) ">: ")))
               (if (not rad) (setq rad lrad) (setq lrad rad))
               (redraw enam2 4)
               (if (not lt1) (setq lt1 0.0))
               (setq t1 (getdist (strcat "\nLeading transition length <" (rtos lt1 2 1) ">: ")))
               (if (not t1) (setq t1 lt1) (setq lt1 t1))
               (if (not lt2) (setq lt2 0.0))
               (setq t2 (getdist (strcat "\nTrailing transition length <" (rtos lt2 2 1) ">: ")))
               (if (not t2) (setq t2 lt2) (setq lt2 t2))
               (if (> (distance p1 ip) (distance p2 ip)) (setq pa p1) (setq pa p2))
               (if (> (distance p3 ip) (distance p4 ip)) (setq pc p3) (setq pc p4))
               (setq ipang (- (angle ip pc) (angle pa ip)))
               (if (>= (abs ipang) pi)
                  (if (minusp ipang) (setq ipang (+ ipang pi pi)) (setq ipang (- ipang (* pi 2))))
               )
               (if (minusp ipang) (setq h -1) (setq h 1))
               (setq ipang (abs (/ ipang 2.0)))
               (entdel (car esel1))
               (cs t1 rad)
               (setq s1 s c1 c rl1 rl in1 in)
               (cs t2 rad)
               (setq s2 s c2 c rl2 rl in2 in sptype 1)
               (spi t1 pa s1 s2 c1 in1 rl1)
               (setq p3 p2 sptype (- 1))
               (setq h (* h -1))
               (entdel (car esel2))
               (spi t2 pc s2 s1 c2 in2 rl2)
               (if (minusp h) (command "arc" p3 "e" p2 "r" rad) (command "arc" p2 "e" p3 "r" rad))
               (command "chprop" (entlast) "" "c" acol "")
;               (command "circle" p2 1.0)
;               (command "circle" p3 1.0)
            )
         )
      )
   )
   (command "undo" "end")
   (princ)
)

(defun cs (l r)
   (if (> l 0)
      (progn
         (setq in (/ l (fix (/ l 2.0))))
         (setq rl (* r l))
         (setq c (- (+ (- (/ l 2.0) (/ (expt l 3.0) (* 240 r r)))
            (/ (expt l 5.0) 34560.0 (expt r 4.0)))
            (/ (expt l 7.0) (expt r 6.0))))
         
         (setq s (+ (- (/ (* l l) 24.0 r) (/ (expt l 4) 2688.0 (expt r 3)))
            (- (/ (expt l 6) 506880.0 (expt r 5)) (/ (expt l 8) 154828800.0 (expt r 7))))
         )
      )
      (setq in 0 rl 0 c 0 s 0)
   )
)

(defun spi (l pt args1 args2 argc argin argrl)
;   (setq yl 0 xl 0)
   (setq aa (* rad (/ (sin ipang) (cos ipang)))
         bb (* args1 (/ (cos (* 2 ipang)) (sin (* 2 ipang))))
         cc (* args2 (/ 1.0 (sin (* 2 ipang))))
   )
   (setq tanlen (+ (- aa bb) cc argc))
   (setq p1 (polar ip (angle ip pt) tanlen) p2 p1)
   (if (> l 0)
      (progn
        ;(command "circle" p1 1.0)
         (setq tang (angle pt ip))
         (setq oang (+ tang (/ pi 2.0)))
         (setq n argin)
         (if (not (regapp "SPIRAL")) (regapp "SPIRAL"))
         (setq xd_list (list '(1002 . "}")))
         (setq xd_list (cons (cons 1040 l) xd_list))
         (setq xd_list (cons (cons 1010 (list argrl tang h)) xd_list))
         (setq xd_list (cons (cons 1070 sptype) xd_list))
         (setq xd_list (cons '(1002 . "{") xd_list))
         (setq xd_list (cons "SPIRAL" xd_list))
         (entmake (list (cons 0 "POLYLINE") (cons -3 (list xd_list)) (cons 66 1)))
         (entmake (list (cons 0 "VERTEX") (cons 10 p1) ))
         (setq xd_list (list '(1002 . "}")))
         (setq xd_list (cons (cons 1040 l) xd_list))
         (setq xd_list (cons (cons 1010 (list 0 0 0)) xd_list))
         (setq xd_list (cons (cons 1070 0) xd_list))
         (setq xd_list (cons '(1002 . "{") xd_list))
         (setq xd_list (cons "SPIRAL" xd_list))
	 (setq V2A (* (sqrt 2.0) (sqrt argrl)))
         (repeat (fix (/ l n))
            (setq x
              (- (+ (- (+ (- n (/ (expt n 5.0) (* 10 (expt V2A 4.0))))
		          (/ (expt n 9.0) 216.0 (expt V2A 8.0)))
                       (/ (expt n 13.0) 9360.0 (expt V2A 12.0)))
                    (/ (expt n 17.0) 685440.0 (expt V2A 16.0)))
		 (/ (expt n 21.0) 76204800.0 (expt V2A 20.0)))
            )
            (setq y
		(* h    
	         (- (+ (- (+ (- (/ (expt n 3.0) 6.0 argrl)
                                (/  (expt n 7.0) 42.0 (expt V2A 6.0)))
			     (/ (expt n 11.0) 1320.0 (expt V2A 10.0)))
			  (/ (expt n 15.0) 75600.0 (expt V2A 14.0)))
		        (/ (expt n 19.0) 6894720.0 (expt V2A 18.0)))
		    (/ (expt n 23.0) 39916800.0 (expt V2A 22.0)))
		)   
            )
	    
            (setq p2 (polar p1 tang x))
            (setq p2 (polar p2 oang y))
            ;(setq a (/ (atan (/ (- y yl) (- x xl))) 2))
            ;(setq blg (* (/ (sin a) (cos a)) (- h)))
            (entmake (list (cons 0 "VERTEX") (cons 10 p2)(cons -3 (list xd_list))))
            (setq xl x yl y)
            (setq n (+ n argin))
         )
         (princ (entmake (list (cons 0 "SEQEND"))))
         (command "pedit" (entlast) "f" "x")
         (command "chprop" (entlast) "" "c" scol "")
      )
   )
   (command "line" pt p1 "")
)

 

fspi.lsp

Edited by ymg3
Corrected link to article
BIGAL Grand Master

BIGAL

Posted
Posted

The header contains a big consulting firm's name here in AUS it may have leaked out many years ago as hinted by the 96. It should match the Australian design of spiral road curves. You should check that it matches your design standards.

 

Found this https://cc4w.net/spiral/SpiralTraining.pdf 

ymg3 Rising Star

ymg3

Posted
Posted

BIGAL,

 

Interesting find, however the app does not design the curve.  It simply draft the spiral given a spiral lenght an a circular curve radius.

 

The computation of the Clothoid aka Spiral aka Cornu aka Euler curve remains the same and is an approximation.

 

As for the app, I've now checked that it works in every orientations.

 

image.thumb.png.c7ee0c608852a513b2b23d06c9dbdf37.png

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...