Author Topic: Calculate polyline bulge  (Read 2531 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 812
Calculate polyline bulge
« 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 but man, I suck at math!  :thinking:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Calculate polyline bulge
« Reply #1 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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Dlanor

  • Bull Frog
  • Posts: 263
Re: Calculate polyline bulge
« Reply #2 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

« Last Edit: April 09, 2020, 04:25:20 PM by Dlanor »

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Calculate polyline bulge
« Reply #3 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.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Calculate polyline bulge
« Reply #4 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...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Calculate polyline bulge
« Reply #5 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

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Calculate polyline bulge
« Reply #6 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.         (entmake
  8.             (list
  9.                '(000 . "LWPOLYLINE")
  10.                '(100 . "AcDbEntity")
  11.                '(100 . "AcDbPolyline")
  12.                '(090 . 2)
  13.                '(070 . 0)
  14.                 (cons 038 (caddr (trans pt1 1 ocs)))
  15.                 (cons 010 (trans pt1 1 ocs))
  16.                 (cons 042 (ppc-bulge pt1 pt2 cen))
  17.                 (cons 010 (trans pt2 1 ocs))
  18.                 (cons 210 ocs)
  19.             )
  20.         )
  21.     )
  22.     (princ)
  23. )

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Calculate polyline bulge
« Reply #7 on: April 11, 2020, 06:05:06 AM »
Thank you Lee! - it serves me a good purpose for manual testing...  :grin:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

hanhphuc

  • Newt
  • Posts: 64
Re: Calculate polyline bulge
« Reply #8 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)
)



« Last Edit: April 12, 2020, 06:55:42 AM by hanhphuc »
( apply 'equal "hp" "happy" "hạnh phúc" "ハッピー" "幸福" "행복" ) ; error: too many arguments