# TheSwamp

## Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Grrr1337 on April 09, 2020, 03:01:18 PM

Title: Calculate polyline bulge
Post by: Grrr1337 on April 09, 2020, 03:01:18 PM
Hi,
I've got a known radius(r), center(cp), start point(sp) and an end point(ep) -
how do I calculate the bulge (dxf42) ?
Respectively the start point(sp) and the endpoint(ep) are consecutive vertices of the pline (e).
I've looked into Lee's bulge conversion functions (http://www.lee-mac.com/bulgeconversion.html) but man, I suck at math!  :thinking:
Title: Re: Calculate polyline bulge
Post by: ribarm on April 09, 2020, 03:24:38 PM
I think you can't without providing LWPOLYLINE ENAME... Here are my mods. of Lee's subs in that regard...

Code - Auto/Visual Lisp: [Select]
1. ;; Bulge to Arc  -  Lee Mac - mod by M.R.
2. ;; p1 - start vertex
3. ;; p2 - end vertex
4. ;; b  - bulge
5. ;; Returns: (<center> <start angle> <end angle> <radius>)
6.
7. (defun LM:Bulge->Arc ( p1 p2 b / a c r )
8.     (setq a (* 2 (atan (abs b)))
9.           r (abs (/ (distance p1 p2) 2 (sin a)))
10.           c (if (minusp b) (polar p2 (+ (- (/ pi 2) a) (angle p2 p1)) r) (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r))
11.     )
12.     (list c (angle c p1) (angle c p2) r)
13. )
14.
15. ;; Arc to Bulge  -  Lee Mac - mod by M.R.
16. ;; c     - center
17. ;; a1,a2 - start, end angle
18. ;; r     - radius
19. ;; lw    - LWPOLYLINE ename
20. ;; Returns: (<vertex> <bulge> <vertex>)
21.
22. (defun LM:Arc->Bulge ( c a1 a2 r lw / data1 data2 )
23.
24.   (if (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a2 r)) 3e-2)) (cdr (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a1 r)) 3e-2)) (entget lw))))
25.     (setq data1 (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a1 r)) 3e-2)) (reverse (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a2 r)) 3e-2)) (reverse (entget lw))))))
26.     (setq data2 (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a2 r)) 3e-2)) (reverse (vl-member-if '(lambda ( x ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (polar c a1 r)) 3e-2)) (reverse (entget lw))))))
27.   )
28.
29.   (list
30.     (if (and data1 (not data2))
31.       (polar c a1 r)
32.       (polar c a2 r)
33.     )
34.     (if (and data1 (not data2))
35.       (if (minusp (cdr (assoc 42 (reverse data1)))) (if (equal (cdr (assoc 42 (reverse data1))) (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))) 3e-2) (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))) (/ 1 (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))))) (if (equal (cdr (assoc 42 (reverse data1))) (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )) 3e-2) (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )) (/ 1 (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )))))
36.       (if (minusp (cdr (assoc 42 (reverse data2)))) (if (equal (cdr (assoc 42 (reverse data2))) (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))) 3e-2) (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))) (/ 1 (- (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ))))) (if (equal (cdr (assoc 42 (reverse data2))) (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )) 3e-2) (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )) (/ 1 (abs ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )))))
37.     ) ;;; This should be either equal to abs or (- abs) of ( (lambda ( x ) (/ (sin x) (cos x))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) )
38.     (if (and data1 (not data2))
39.       (polar c a2 r)
40.       (polar c a1 r)
41.     )
42.   )
43. )
44.

HTH., M.R.
Title: Re: Calculate polyline bulge
Post by: Dlanor on April 09, 2020, 04:20:11 PM
Here's mine for that situation

Code - Auto/Visual Lisp: [Select]
1. (defun rh:bulge (r h) (/ (- r (sqrt (- (expt r 2) (expt h 2)))) h))

r is the radius and h is half the chord length (/ (distance sp ep) 2.0)

if cp sp ep is clockwise it's positive otherwise negative

Title: Re: Calculate polyline bulge
Post by: Grrr1337 on April 10, 2020, 02:22:48 AM
Marko,
Would this be the correct call for your sub?

Code - Auto/Visual Lisp: [Select]
1. (defun _f ( p / LM:round e o prm r )
2.   (defun LM:round ( n )(fix (+ n (if (minusp n) -0.5 0.5))))
3.   (and
4.     ; (setq p (getpoint "\nPick a point: "))
5.     (setq e (car (nentselp (osnap p "_nea"))))
6.     (setq o (vlax-ename->vla-object e))
7.     (setq prm (LM:round (vlax-curve-getParamAtPoint o p)))
8.     (setq r (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv o prm)))
9.     ; (vlax-curve-getFirstDeriv curve-obj param)
10.   ); and
11.   r
12. ); defun _f
13. ; Upon manual testing -
14. (LM:arc->bulge (getpoint "\nCenter: ") (_f (getpoint "\nAngle1: ")) (_f (getpoint "\nAngle2: ")) (getreal "\nRadius: ") (car (entsel "\nPick the lwpline: ")))

If so - how it differs from Lee's original LM:Arc->Bulge sub - I mean why taking the additional LWPOLYLINE ENAME argument..

Thanks Dlanor - it worked!
Now I see that my algorithm is wrong, on the calculation of the bulge's start and end.
Title: Re: Calculate polyline bulge
Post by: ribarm on April 10, 2020, 03:02:16 AM
@Grrr, everything important is explained in sub functions headers... You have to have real situation where you want to acquire bulge from lwpolyline arc segment... I pulled out those my mods. from routine I used in real situation - there is no way you can determine sign of bulge arced segment as lwpolyline can't be neither clockwise nor counter clockwise oriented - such property don't exist - that's why you have to specify ename as an argument... Study what sub is doing and you'll see that there is big reasons why ename is necessity... I hope I am clear - you have to have real situation from where you want to pull out bulge value - not just math calculation... If you are searching for just abs value then simply take angle and calculate tang of quarter of it...
Title: Re: Calculate polyline bulge
Post by: Marc'Antonio Alessi on April 10, 2020, 06:26:09 AM
Marko I don't know if my reflection is right and valid but I think it is preferable, to avoid confusion when someone is looking for a function, that the names of the functions should be changed and highlighted what has been changed and why.
example:
;; original LM:Arc->Bulge  Arc to Bulge  -  Lee Mac - mod by M.R. > MR:Arc->Bulge
;; original LM:Bulge->Arc  Bulge to Arc  -  Lee Mac - mod by M.R. > MR:Bulge->Arc

Thanks
Title: Re: Calculate polyline bulge
Post by: Lee Mac on April 10, 2020, 07:24:39 AM
Since you have the center, start & end points, the radius & orientation are both known.

As, such, I think the function can be written as:
Code - Auto/Visual Lisp: [Select]
1. (defun ppc-bulge ( pt1 pt2 cen / a )
2.     (setq a (/ (rem (+ pi pi (- (angle cen pt2) (angle cen pt1))) (+ pi pi)) 4.0))
3.     (if (LM:clockwise-p pt2 cen pt1) (setq a (- a (/ pi 2.0))))
4.     (/ (sin a) (cos a))
5. )
6.
7. ;; Clockwise-p  -  Lee Mac
8. ;; Returns T if p1,p2,p3 are clockwise oriented
9.
10. (defun LM:clockwise-p ( p1 p2 p3 )
11.     (<  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
12.         (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
13.     )
14. )

A quick program to test:
Code - Auto/Visual Lisp: [Select]
1. (defun c:test ( / cen ocs pt1 pt2 )
2.     (if (and (setq pt1 (getpoint "\nStart point: "))
3.              (setq pt2 (getpoint "\nEnd point: " pt1))
4.              (setq cen (getpoint "\nCenter: "))
5.              (setq ocs (trans '(0 0 1) 1 0 t))
6.         )
7.             (list
8.                '(000 . "LWPOLYLINE")
9.                '(100 . "AcDbEntity")
10.                '(100 . "AcDbPolyline")
11.                '(090 . 2)
12.                '(070 . 0)
13.                 (cons 038 (caddr (trans pt1 1 ocs)))
14.                 (cons 010 (trans pt1 1 ocs))
15.                 (cons 042 (ppc-bulge pt1 pt2 cen))
16.                 (cons 010 (trans pt2 1 ocs))
17.                 (cons 210 ocs)
18.             )
19.         )
20.     )
21.     (princ)
22. )
Title: Re: Calculate polyline bulge
Post by: Grrr1337 on April 11, 2020, 06:05:06 AM
Thank you Lee! - it serves me a good purpose for manual testing...  :grin:
Title: Re: Calculate polyline bulge
Post by: hanhphuc on April 12, 2020, 03:57:47 AM
Since you have the center, start & end points, the radius & orientation are both known.

As, such, I think the function can be written as:
Code - Auto/Visual Lisp: [Select]
1. (defun ppc-bulge ( pt1 pt2 cen / a )
2.     (setq a (/ (rem (+ pi pi (- (angle cen pt2) (angle cen pt1))) (+ pi pi)) 4.0))
3.     (if (LM:clockwise-p pt2 cen pt1) (setq a (- a (/ pi 2.0))))
4.     (/ (sin a) (cos a))
5. )
6.

nice Lee since this topic related to bulge

i just share alternative if center is unknown, but known = radius , vertex , p1 , p2  (note: vertex =/= center)
returns list (start bulge end)
like fillet method

Code - Auto/Visual Lisp: [Select]
1.
2. (defun ripp-bulge (r ip p1 p2 / x A d)
3.   ;hanhphuc
4.   (if
5.     (not (zerop (setq x (mapcar '(lambda (p) (angle ip p)) (list p1 p2))
6.                       A (apply '- x)
7.                 )
8.          )
9.     )
10.      (setq A (if (minusp A)
11.                (+ pi pi A)
12.                A
13.              )
14.            d (abs (/ r (tan (* A 0.5))))
15.            r (list (polar ip (car x) d)
16.                    (tan (* (rem (- (+ pi pi) (+ pi A)) pi) 0.25))
17.                    (polar ip (cadr x) d)
18.              )
19.      )
20.   )
21. )
22.
23. (defun tan (x) (/ (sin x) (cos x))) ;
24.
25.

test
Code: [Select]
`(defun c:test1 (/ dxf en grr ip l ls p1 p2 r)  (initget 7)  (and    (setq r (getdist "\nRadius : "))    (setq ip (getpoint "\nSpecify vertex : "))    (setq p1 (getpoint ip "\np1 "))    (while      (and (setq grr (grread t 13))           (= (car grr) 5)           (setq p2 (cadr grr))           (vl-consp p2)      );;;    (setq p2 (getpoint ip "\np2 "))      (redraw)      (and        (setq l (ripp-bulge r ip p1 p2)              ls (mapcar '(lambda (x)                              (if                                (listp x)                                (trans x 1 0)                                x                              )                            )                         l                 )        )           (if (or en                 (progn                   (setq                     en (entmakex (vl-list* '(0 . "LWPOLYLINE")                                            '(100 . "AcDbEntity")                                            '(100 . "AcDbPolyline")                                            '(90 . 2)                                            '(70 . 0)                                            (mapcar 'cons '(10 42 10) ls)                                  )                        )                   )                   (setq                     dxf (vl-remove-if                           '(lambda (x) (vl-some '(lambda (i) (= (car x) i)) '(10 42)))                           (entget en)                         )                   )                 )               )             (entmod (append dxf (mapcar 'cons '(10 42 10) ls)))           )        (foreach x (list (car l) (caddr l))          (grdraw ip x 2)        )      )    )  )  (princ))`