Author Topic: Wanted: basket curve / three center curve  (Read 2721 times)

0 Members and 1 Guest are viewing this topic.

Peter2

  • Swamp Rat
  • Posts: 650
Wanted: basket curve / three center curve
« on: March 04, 2019, 07:25:51 AM »
Hi

I don't know if I'm using the correct word, but I'm looking for a lisp which creates a "basket curve" / two-center-curve / three center curve.

(A curve whith 2 or three tangential following arc; something like this:
https://de.wikipedia.org/wiki/Datei:Korbbogen;_einh%C3%BCftig_c.jpg)

Is not that important, but if there are existing tools I will be ahppy for a hint

Peter
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: Wanted: basket curve / three center curve
« Reply #2 on: March 04, 2019, 08:57:12 AM »
Hi,

I'm not sur to understand what you want to achieve.
If you're talking about 'basket-handle' (anse de panier in French), here's some code I wrote some times ago BH3 command  a draws a 3 centers 'basket-handle' curve (polyline) and BH7 a 7 centers one.

Code - Auto/Visual Lisp: [Select]
  1. ;;----------------------------------------------------------;;
  2. ;;                      INITIALIZATION                      ;;
  3. ;;----------------------------------------------------------;;
  4.  
  5. (or *acad* (setq *acad* (vlax-get-acad-object)))
  6. (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  7.  
  8. ;;----------------------------------------------------------;;
  9. ;;                     GENERAL ROUTINES                     ;;
  10. ;;----------------------------------------------------------;;
  11.  
  12. ;; gc:AddLwPolyline
  13. ;; Creates a polyline in the current space from a list of 2d points
  14. (defun gc:AddLwPolyline (pts)
  15.     (vlax-get *acdoc*
  16.               (if (= 1 (getvar 'cvport))
  17.                 'PaperSpace
  18.                 'ModelSpace
  19.               )
  20.     )
  21.     'AddLightWeightPolyline
  22.     (apply 'append pts)
  23.   )
  24. )
  25.  
  26. ;; gc:Ang<2pi
  27. ;; Returns the angle in 0 2*PI range
  28. (defun gc:Ang<2pi (ang)
  29.   (if (and (<= 0 ang) (< ang (* 2 pi)))
  30.     ang
  31.     (gc:Ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
  32.   )
  33. )
  34.  
  35. ;; gc:Convert2d
  36. ;; Converts a 3d point into a 2d point
  37. (defun gc:Convert2d (pt)
  38.   (list (car pt) (cadr pt))
  39. )
  40.  
  41. ;; gc:clockwise-p
  42. ;; Returns T if p1 p2 et p3 are clockwise
  43. (defun gc:clockwise-p (p1 p2 p3)
  44.   (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
  45. )
  46.  
  47. ;; gc:tan
  48. ;; Returns the tangent of the angle
  49. (defun gc:tan (a) (/ (sin a) (cos a)))
  50.  
  51. ;;----------------------------------------------------------;;
  52. ;;                    SPECIFIC ROUTINES                     ;;
  53. ;;----------------------------------------------------------;;
  54.  
  55. ;; bh_input
  56. ;; Gets input for c:BH3 et c:BH7
  57. (defun bh_input (/ *error* asnp snpa ortho p1 p2 p3 p4 tmp norm elv)
  58.   (defun *error* (msg)
  59.     (and msg
  60.          (/= msg "Function cancelled")
  61.          (princ (strcat "\nError: " msg))
  62.     )
  63.     (setvar 'snapang snpa)
  64.     (setvar 'orthomode ortho)
  65.     (setvar 'autosnap asnp)
  66.   )
  67.   (setq snpa  (getvar 'snapang)
  68.         ortho (getvar 'orthomode)
  69.         asnp  (getvar 'autosnap)
  70.   )
  71.   (initget 1)
  72.   (setq p1 (getpoint "\nCurve start: ")
  73.         p2 p1
  74.   )
  75.   (while (equal p1 p2)
  76.     (setq p2 (getpoint p1 "\nCurve end: "))
  77.   )
  78.   (setq p3 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2)
  79.         p4 p3
  80.   )
  81.   (setvar 'snapang (angle p1 p3))
  82.   (setvar 'orthomode 1)
  83.   (while (equal p3 p4)
  84.     (setq p4 (getpoint p3 "\nCurve summit: "))
  85.   )
  86.   (or (gc:clockwise-p p1 p2 p4)
  87.       (setq tmp p1
  88.             p1  p2
  89.             p2  tmp
  90.       )
  91.   )
  92.   (setq p4 (polar p3
  93.                   (+ (angle p2 p1) (/ pi 2))
  94.                   (distance p3 p4)
  95.            )
  96.   )
  97.   (setq norm (trans '(0. 0. 1.) 1 0 T)
  98.         elv  (caddr (trans p3 1 norm))
  99.   )
  100.   (foreach p '(p1 p2 p3 p4)
  101.     (set p (gc:Convert2d (trans (eval p) 1 norm)))
  102.   )
  103.   (*error* nil)
  104.   (list p1 p2 p3 p4 norm elv)
  105. )
  106.  
  107. ;;----------------------------------------------------------;;
  108. ;;                        COMMANDS                          ;;
  109. ;;----------------------------------------------------------;;
  110.  
  111. ;; BH3
  112. ;; Draws a basket-handle arch with 3 centers
  113. (defun c:BH3 (/ p1 p2 p3 p4 p5 norm elv a1 a2 r pl)
  114.   (mapcar '(lambda (s v) (set s v)) '(p1 p2 p3 p4 norm elv) (bh_input))
  115.   (setq a1 (atan (distance p3 p4) (distance p1 p3))
  116.         a2 (atan (distance p1 p3) (distance p3 p4))
  117.         r  (/ (* (distance p1 p4) (+ 1 (cos a1) (- (sin a1))))
  118.               (* 2 (sin a1))
  119.            )
  120.         p5 (polar p4 (+ (angle p1 p2) (/ pi 2)) r)
  121.   )
  122.   (vla-StartUndoMark *acdoc*)
  123.   (setq pl (gc:AddLwPolyline
  124.              (list p1
  125.                    (polar p5 (- (angle p5 p4) a1) r)
  126.                    (polar p5 (+ (angle p5 p4) a1) r)
  127.                    p2
  128.              )
  129.            )
  130.   )
  131.   (vla-setBulge pl 0 (gc:tan (/ a2 4.0)))
  132.   (vla-setBulge pl 1 (gc:tan (/ a1 2.0)))
  133.   (vla-setBulge pl 2 (gc:tan (/ a2 4.0)))
  134.   (vlax-put pl 'Normal norm)
  135.   (vla-put-Elevation pl elv)
  136.   (vla-EndUndoMark *acdoc*)
  137.   (princ)
  138. )
  139.  
  140. ;; BH7
  141. ;; Draws a basket-handle arch with 3 centers
  142. (defun c:BH7 (/ pt0 pt1 pt2 pt3 pt4 pt5 cen norm elv ac0 ac4 pi/4 tmp1  tmp2 a04 a02 a24 bsc0 bsc2
  143.                bsc3 bsc4 plst blst)
  144.   (mapcar '(lambda (s v) (set s v)) '(pt0 pt8 cen pt4 norm elv) (bh_input))
  145.   (setq ac0  (angle cen pt0)
  146.         ac4  (angle cen pt4)
  147.         pi/4 (+ ac0 (/ pi 4.))
  148.         tmp1 (polar cen pi/4 (distance cen pt0))
  149.         tmp2 (polar cen pi/4 (distance cen pt4))
  150.         pt2  (inters tmp1 (polar tmp1 ac4 1.) tmp2 (polar tmp2 ac0 1.) nil)
  151.         a04  (angle pt0 pt4)
  152.         a02  (angle pt0 pt2)
  153.         a24  (angle pt2 pt4)
  154.         bsc0 (/ (gc:Ang<2pi (- a02 ac4)) 2.)
  155.         bsc2 (/ (gc:Ang<2pi (- a04 a02)) 2.)
  156.         bsc3 (/ (gc:Ang<2pi (- a24 a04)) 2.)
  157.         bsc4 (/ (gc:Ang<2pi (- (+ ac0 pi) a24)) 2.)
  158.         pt1  (inters pt0
  159.                      (polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
  160.                      pt2
  161.                      (polar pt2 (+ a02 bsc2) 1.)
  162.                      nil
  163.              )
  164.         pt3  (inters pt2
  165.                      (polar pt2 (+ a04 bsc3) 1.)
  166.                      pt4
  167.                      (polar pt4 (+ a24 bsc4) 1.)
  168.                      nil
  169.              )
  170.         plst (list pt4 pt3 pt2 pt1 pt0)
  171.         blst (mapcar '(lambda (b) (gc:tan (/ b 2.)))
  172.                      (list bsc4 bsc3 bsc2 bsc0)
  173.              )
  174.   )
  175.   (foreach b blst
  176.     (setq blst (cons b blst))
  177.   )
  178.   (foreach p (cdr plst)
  179.     (setq ang  (angle cen p)
  180.           plst (cons
  181.                  (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
  182.                  plst
  183.                )
  184.     )
  185.   )
  186.   (vla-StartUndomark *acdoc*)
  187.   (setq pl (gc:AddLwPolyline (reverse plst)))
  188.   (mapcar '(lambda (i v) (vla-SetBulge pl i v))
  189.           '(0 1 2 3 4 5 6 7 8)
  190.           blst
  191.   )
  192.   (vlax-put pl 'Normal norm)
  193.   (vla-put-Elevation pl elv)
  194.   (vla-EndUndomark *acdoc*)
  195.   (princ)
  196. )

If you want to draw a curve like the one in the link you provided, we call it arc rampant in French (rampant arch?), you can try the following one which draw the arch with the vertical relative to the current UCS Y axis.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:RAMPANT_ARCH (/ p1 p2 cen p3)
  2.   (if (and (setq p1 (getpoint "\nStart point: "))
  3.            (setq p2 (getpoint p1 "\nStart point: "))
  4.       )
  5.     (progn
  6.       (setq cen (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)
  7.             p3  (mapcar '+ cen (list 0. (distance cen p1) 0.))
  8.       )
  9.       (command "_.pline" "_non" p1 "_arc" "_direction" "_non" (mapcar '+ p1 '(0. 1. 0.)) "_non" p3 "_non" p2 "")
  10.     )
  11.   )
  12.   (princ)
  13. )
« Last Edit: March 04, 2019, 09:01:13 AM by gile »
Speaking English as a French Frog

Peter2

  • Swamp Rat
  • Posts: 650
Re: Wanted: basket curve / three center curve
« Reply #3 on: March 04, 2019, 09:45:27 AM »
@Marko:

thanks, looks fine.

Somewhere in all the code-editing and quoting the "quadratic solution" from Lee lost the last characters. Here is the right one:

(   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)

@gile:
Thanks too - I will take a look.
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

Peter2

  • Swamp Rat
  • Posts: 650
Re: Wanted: basket curve / three center curve
« Reply #4 on: March 04, 2019, 10:19:17 AM »
......what you want to achieve....

Good question.

I was asked by one of my colleagues, drawing situation plans from surveying. The result should be a kind of "fillet" with two different  arcs.
I doubt that there is an "exact" solution (impossible to define the geometric criterias), and maybe the result will be a little bit of supported try and draw.

The surveyors have measured the border of a street, the have
- the blue line
- the blue point
- some memories and some sketch how it "approx. looked like"

The want to
- create the curve
- with two different arcs (red, yellow)
- which start tangential at the blue line
- changes radius tang.
- use self selected values for radius (exactly: round values like 2.5 and 3 instead of calculated values like2.48679264)
- end the line at blue point (angle is not important)

I think that's impossible ..
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Wanted: basket curve / three center curve
« Reply #5 on: March 04, 2019, 12:11:25 PM »
See pictures... Finally trim red and cyan circles...

(continued in next post...)

Regards...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Wanted: basket curve / three center curve
« Reply #6 on: March 04, 2019, 12:12:07 PM »
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Wanted: basket curve / three center curve
« Reply #7 on: March 04, 2019, 12:51:38 PM »
Somewhere in all the code-editing and quoting the "quadratic solution" from Lee lost the last characters. Here is the right one:

(   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)


Unfortunately after a recent "upgrade" of the forum software over at CADTutor, the characters 8) were removed from all code in which they appear, for example (equal 0.0 var 1e-8) would become (equal 0.0 var 1e-

Also, the code blocks no longer support the use of BBCode colour tags, and consequently these are now displayed in each code block.  :-(

Nevertheless, I have now edited my posts to hopefully correct the code.

Peter2

  • Swamp Rat
  • Posts: 650
Re: Wanted: basket curve / three center curve
« Reply #8 on: March 06, 2019, 03:35:16 AM »
Thanks to Marko and Lee!
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23