Topic: spiral-circle-spiral geometry

[pedroantonio]

Hi, i am beginner in lisp and i need some help. I want a lisp
a)give manualy some parametrs
b) draw a  spiral-circle-spiral geometry between two lines
c)print a table like the dwg file or exit the parametrs to *.txt

Look the attach files for more details

I know that my code is very poor , but i need help

Code - Auto/Visual Lisp: [Select]

1. defun  c:test (/ K x m m1 h e L T d V KE A GG1)
2.  
3. ;Get User Inputs       
4. ;get the coordinates of K
5. (setq K ( getpoint "\nChoose a Point K: "))
6.  
7. ;get the length of x
8. (setq x (getdist "\nLength of x : "))
9.        
10. ;get the length of m
11. (setq m (getdist "\nLength of m : "))
12.  
13.  ;get the length of m1
14. (setq m1 (getdist "\nLength of m1 : "))
15.  
16.  ;get the length of h
17. (setq h (getdist "\nLength of h : "))
18.  
19.  ;get the length of e
20. (setq e (getdist "\nLength of e : "))
21.  
22.  ;get the length of L
23. (setq L (getdist "\nLength of L : "))
24.  
25.  ;get the length of T
26. (setq T (getdist "\nLength of T: "))
27.  
28.  ;get the length of d
29. (setq T (getdist "\nLength of d: "))
30.  
31.  ;get the length of V
32. (setq T (getdist "\nLength of V: "))
33.  
34. ;End of User Inputs
35. ;********************************************************
36.         ;Start of Calculations
37.  
38. (setq KE (-T m))
39. (setq A (sqrt (* R L)))
40. (setq GG1 (- V (* 2 L)))
41.        
42.   ;End of Calculations
43.  
44. ;**********************************************************
45.         ;Start of Command Function
46.  
47.         (command "arc" G P G1 "c")        ;End Command
48.         ;End of Command Function
49. ;**********************************************************
50.  

Thanks

[pedroantonio]

a better photo with the symbols

[ymg]

Bonuscad has one here : http://bonuscad.perso.sfr.fr/

Look for clothoide.

[pedroantonio]

Thank you ymg , but clothoide.lsp is not working as i want. I am not good with lisp so i can not write the code .Can you help me.I want to give the parametrs like the start code in post 1,then select the two lines or polyline and then draw the clothoide

Thanks

[LE3]

I think it is time to add this comment:

This website has excelled others, first by his administration, then the contribution of its members, including the best in the field of programming, and has left here, lots of examples and in many cases some applications with minimal effort can to tailor the user. Many of its members also help others by providing them complete solutions on occasion, but if we find are those members who have excelled also helping others through the years or in a short time we see their dedication and most of all their effort to help.
Now they come here and just wait for other members to resolve everything without any effort (They sometimes disguise their questions as a challenge or even asked to resolve complex problems, pretending to be nice people, and kept playing that role), I do not think it's fair, in recent months some new members who have registered here, just come to expect others to do their jobs or homework, without even making any minimal effort or deserve it.
To distinguish these members, is very easy and simple, I just hope that they not going to get any help at all, until they really end up having their own merits.
If we continue like this, others will just come here thinking that the problems are resolved for free and that no effort is required.
This is not this site, or what has distinguished itself over the years, this is TheSwamp.org, the best place to contribute and learn.

Same comment can be found on his own topic, here:
http://www.theswamp.org/index.php?topic=47089.msg521200#msg521200

[pedroantonio]

Hi LE you are right and i agry with you ,but in post 1 i have allready write same lines of code.I dont know mutch but i am trying to learn. I know that am asking for samething complicated thats why i ask help.

Thanks

[reltro]

@LE +100

@Topographer
Can u calculate a clothoide step by step by hand?
If so, start with PseudoCode and then, start (at least try it) to code each step in Lisp.
If there is an error, post ur Code and here will be people who help u to find it; I'm pretty sure about...

the "Code" in Post 1... I think u never tried running it... it will fail with an ; error: bad argument type: numberp: nil

reltro

[reltro]

If I look in ur first Post, I won't be able to calculate the clothoide/curve... there are too much Inputs I think...
"normally" (my normal ) there are given, if u are planning a street...

K... the Vertex of the "Polyline"
K0 ... Some Point on the Polyline to calculate the Start-Tangent
K1 ... Some Point on the Polyline to calculate the End-Tangent

A1 ... Parameter of the start-Clothoide
A2 ... Paramter of the end-Clothoide
R ... Radius of the Arc between start- and end-Clothoide

Should be enough and not to much to calculate the curve...

reltro

[hanhphuc]

; Hi my concept firstly to determine the offsets, transitions, tangent Xs Ys LT ST Øs Øc Es K value etc..
; check or measure the spiral,arc ,linear dimensions comparing to the parameters in order to understand & get the ideas
; (see the example "SCC demo.dwg")
; if we are clear about the concept then we could proceed next step making polylines :kewl:
;
; i hope this simple function could help with minimal input?
; Main function= (cloth dA RC LS) which input basic parameters: Deflections angle (degrees), Radius & Spiral length
; Then i applied in routine C:TEST
; Command: TEST

;19/05/14  hp

Code: [Select]

; just a little contribution
; (cloth dA RC LS)

; Regular spiral-circular-spiral fundamental elements
; Formulae Reference: JKR civil engineering road design standard

;Argument , real number
;dA (degrees)
;RC
;LS
;returns: list of curvilinear geometry parameters



(mapcar 'setvar '("lunits" "angbase" "angdir" "luprec") (list 2 (/ pi 2) 1 4)
)

(defun rtod (num) (* 180.0 (/ num pi)))

(defun dtor (num)(* pi (/ num 180.0)))

(defun tan (num) (if(equal (cos num) 0. 1e-10)(*(/ 180. pi)1e+16)(/ (sin num) (cos num)))) ;R1.0
;*note: In math, tan 90 degrees should return infinity. This tan just "by passes" up to max 1e+16.
; rename this "tan" if u have your original "tan" function.

(defun cloth (dA#  RC  LS   / dAR  dAR/2  DC# TC
      LC   EC TS   QS#  C#   dAc#  dAcR QC#  XS   YS QS
      ALC  LT ST   K#   P#   q##  TS# ES#  TC#  LC# EC#
      A#   dAcR
     )

  (setq
    dAR   (dtor dA#) ; radians
    dAR/2 (/ dAR 2.)
    DC#   (/ 5729.578 RC)
    QS#   (/ (* LS DC#) 200.0)
    QS   (dtor QS#) ; radians
    C#   (/ (* 0.0031 (expt QS# 3.)) 3600.0)
    dAc#   (- dA# (* QS# 2.0))
    dAcR  (dtor dAc#) ; radians
    QC#   (- (/ QS# 3.0) C#)
    XS   (* LS
     (+ (- (+ (- 1.0
(/ (expt QS 2.0) 10.0)
      ) ;-
      (/ (expt QS 4.0) 216.0)
   ) ;+
   (/ (expt QS 6.0) 9360.0)
) ;-
(/ (expt QS 8.0) 685440.0)
     ) ;+
  ) ;*

    YS   (* LS
     (+ (- (+ (- (/ QS 3.0) (/ (expt QS 3.0) 42.0)) ;-
      (/ (expt QS 5.0) 1320.0)
   ) ;+
   (/ (expt QS 7.0) 75600.0)
) ;-
(/ (expt QS 9.0) 6894720.0)
     ) ;+
  ) ;*
    ALC   (/ XS (cos (dtor QC#)))
    LT   (- XS (/ YS (tan QS)))
    ST   (/ YS (Sin QS))
    K#   (- XS (* RC (sin QS)))
    P#   (- YS (* RC (- 1.0 (cos QS))))
    q##   (/ P# (cos dAR/2))
    TS#   (+ (* (+ RC P#) (tan dAR/2)) K#)
    ES#   (- (/ (+ RC P#) (cos dAR/2)) RC)

    TC#   (* (tan (/ dAcR 2.0)) RC)
    LC#   (/ (* dAc# Pi RC) 180.0)
    EC#   (- (/ RC (cos (/ dAcR 2.0))) RC)
    A#   (sqrt (* RC LS))
  ) ;end setq

  (if (< LC# 0)
    (Progn (Alert
     "\nSpiral Overlaps?! Invalid curve data\nPlease retry..."
   )
   (setq LC# 0.0)
   (exit)
    )
    (list DC# QS# QC# XS YS ALC LT ST TS# ES# K# P# q## A# dAc# TC# LC#
  EC#)
  )
) ; defun clothd data




(defun C:TEST nil
(if(member nil(list dA Radius LSpiral))
(setq dA 90. LSpiral 0.0 Radius 100.); sets default variables globally
)
 
(setvar "cmdecho" 0)
(setq *cancel* *error*)
(defun *error* (error:)
(if (or(= error: "Function cancelled")(= error: "quit / exit abort"))
(princ "*Cancel*")(princ (strcat "\n\; error: " error: )))

  (setq *error* *cancel*
           *cancel* nil)
  (princ))

(Princ "\nRequires 3 Parameters: Deflection, Radius, Spiral length")
(princ)

(initget 7)
(setq  dA (getreal
(strcat "\nDeflection Angle, <"(rtos dA )"> ")); Input angle in fractions degrees
)
(initget 7)
(setq Radius (getreal (strcat     "Radius  of  the  curve <"(rtos Radius )">. Input Rc : ")))

(initget 5)
(setq LSpiral (getreal (strcat     "Length of spiral curve <" (rtos LSpiral )">. Input Ls : "))
)
 
(if(zerop LSpiral)(setq LSpiral (+ LSpiral 1e-15)))
 
(mapcar '(lambda (abbr val)
(princ (strcat abbr (rtos val )))
)
(list (strcat "\n\nIP Parameters"
      "\n"(Chr 208)"A \t= " (rtos dA ) ; degrees
            "\nRc \t= " (rtos Radius )
"\n----------------------"
      "\nSpiral Curve"
    "\n\nLs \t= " (rtos LSpiral )
      "\nDc \t= ")
      (strcat "\n" (chr 216) "s \t= ") ; degress
      (strcat "\n" (chr 216) "c \t= ") ; degress
      "\nXs \t= "
      "\nYs \t= "
      "\nLC \t= "
      "\nLT \t= "
      "\nST \t= "
      "\nTs \t= "
      "\nEs \t= "
      "\nK  \t= "
      "\nP  \t= "
      "\nq  \t= "
      "\nA  \t= "
      (strcat "\n----------------------"
      "\nInternal Circular"
      "\n\n"
      (Chr 208)
      "A'\t= " ;degrees
      )
      "\nTc'\t= "
      "\nLc'\t= "
      "\nEc'\t= "
)
(cloth dA Radius LSpiral)
)
(textpage)
(princ)
  ); End of C:TEST

[hanhphuc]

My code based on LLM & JKR's geometry formulae, abbreviations may differ however the result is same, it's just math :kewl:

[hanhphuc]

;hi i just try to help with more simple code using this alternative equations.
;Xs = L - (L^5 / 40K^2)
;Ys = L^3 / 6K - L^7 / 336 K^3
;where K = LS * R
;Note that the Xs & Ys values have less accuracy compared to equations previously posted.
;my site engineer uses this formula because short & easy to remember
;21/05/14  hp#005

;Main function= (Ls->XY L LS R); argument real#
;where L=length along spiral, LS=Given spiral max length, R=Radius



;applied in C:TEST

Code: [Select]

(mapcar 'setvar '("lunits" "angbase" "angdir" "luprec") '( 2 1.570796326794896 1 3)
)
(defun Ls->XY (L LS R / K)
  (setq K (* LS R))
  (list
    (- L (/ (expt L 5.) (* 40. (* K K))))
    (- (/ (expt L 3.) (* 6. K))
       (/ (expt L 7.) (* 336. (expt K 3.)))
    )
  )
)

(defun flatz ( _pt / _lst); <-- **R1.0
(list (car(setq _lst (mapcar '(lambda (a b) (+ (float a) b)) _pt (getvar "ucsorg"))))
(cadr _lst));
)

(defun C:TEST (/ xy i Len Rc lst ins ep en)
(setvar "cmdecho" 0)
(setq *cancel* *error*)
(defun *error* (error:)
(if (or(= error: "Function cancelled")(= error: "quit / exit abort"))
(princ "*Cancel*")(princ (strcat "\n\; error: " error: )))
(setq *error* *cancel* *cancel* nil)
(princ))
 
(initget 7)
(setq Len (getreal "\nSpiral Length? :\t"))
(initget 2)
(setq Rc (getreal "\nRadius +/- ? :\t") ;if input negative = anti-clockwise, else clockwise
      lx (/ Len 16.)
      i 1
      ins (flatz (trans (getpoint "\nStart TS/ST..\t")1 0)) ;insertion point
      ep (trans(getpoint "\nEnd..\t")1 0) ;IP or endpoint (tangential direction from ins)
      xy (list '(0. 0.)))
 
(repeat 16
  (setq xy (cons (Ls->XY (* lx (float i)) Len (* -1. Rc)) xy)
   i (1+ i))
  ); repeat

(if xy
(progn
  (setq en
(entmakex
   (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(8 . "Spiral")
       '(100 . "AcDbPolyline")
       (cons 90 (length xy))
       '(70 . 0)
     )
     (mapcar '(lambda (x) (cons 10 x))
     (foreach p xy (setq lst (cons (mapcar '+ p ins) lst)))
     )
   ) ;append
)
  )
  (vl-cmdf "_ROTATE"                    ;simply uses command for easy explaination
   en
   ""
   (trans ins 0 1)
   (- 0. (rtod (angle ins ep))) 
  )
  (vl-cmdf "_PEDIT" en "Fit" "")        ;smoothen polyline
) ;progn
)                                       ;if
(princ "\nDone..")
  (princ)
  ); end