Topic: Select Poly ARC loop for Radius Filter

[ScottMC]

Hoping to find a solution [I've tried ] to filter, or something, a selection of a poly-arc to get the center and radius. This code gets it but errors-out when not picking an arc segment. Additionally a loop to solve the selection and multiple use of it would be helpful. ANY ideas/changes to this lsp I found will be appreciated!

Code: [Select]

;;  http://forums.autodesk.com/autodesk/attachments/autodesk/130/225916/1/Bulge-Center.txt

;by Fatty The Old Stupid Horse
;; helper functions ;;
;; group list in sublists
 
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
(repeat num (setq ls
    (cons (car lst) ls)
      lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
      ls nil)))
    )
ret
  );+
 
;get polyline vertices
 
(defun get-vexs (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
    verts
  (cond
    ((wcmatch (vlax-get pline_obj 'Objectname )
     "AcDb2dPolyline,AcDb3dPolyline")
     (group-by-num verts 3)
    )
    ((eq (vlax-get pline_obj 'Objectname )
     "AcDbPolyline")
     (group-by-num verts 2)
    )
    (T nil)
  )
        )
  );+
;; get bulge radius
;; math by Juergen Menzi
(defun get-radii  (p1 p2 bulge)
       (abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2)))) ;; crashed here from lack of arc selection
  );+

;;get segment arc center
;;math by John Uhden
(defun get-segm-center  (pline p1 p2 bulge / cpt midc midp rad)
(setq rad (get-radii p1 p2 bulge)
      midp (vlax-curve-getpointatparam pline
       (+ (fix (vlax-curve-getparamatpoint pline p1)) 0.5))
      midc (mapcar (function (lambda (x y)(/ (+ x y) 2))) p1 p2)
      cpt (trans (polar midp (angle midp midc) rad) 0 1)
)
cpt
);+

;main part;; Vertex of Polyline Arc Segment:
(defun C:SAP (/ *error* bpt bulg cent coors ent ept
                            pln rad segm snap_pt spt) ;;
(vl-load-com)

  (setq pln
   
            (vlax-ename->vla-object
          (car (setq ent
               
        (entsel "\n   Polyline Vertex of Polyline Arc Segment:\n  Select Arc of Polyline:"))
               
                 )))

(setq snap_pt (trans (cadr ent) 1 0)
      bpt (vlax-curve-getclosestpointto pln snap_pt))
(if (eq (vla-get-Closed pln) :vlax-false)
    (setq coors (get-vexs pln))
    (progn (setq coors (get-vexs pln))
   (setq coors (append coors (list (car coors))))))
(setq segm (fix (vlax-curve-getparamatpoint pln bpt))
      spt (nth segm coors)
      ept (nth (1+ segm) coors)
      bulg (vla-getbulge pln segm)
      rad (get-radii spt ept bulg)
      cent (trans (get-segm-center pln spt ept bulg) 1 0))
     
(princ (strcat "   Radius: " (rtos rad)))

(if (= bulg nil)  (princ "\n Straight Segment Selected.") )

 (if  (not (= bulg nil))
    (progn
 
;TesT Adds circle from arc selected
; (vlax-invoke (vla-get-modelspace
       ; (vla-get-activedocument
; (vlax-get-acad-object)))
 ; 'Addcircle cent rad)
 
(vlax-invoke (vla-get-modelspace
       (vla-get-activedocument
(vlax-get-acad-object)))
  'AddLightWeightPolyline
  (apply 'append (mapcar (function (lambda(x)
    (list (car x)(cadr x))))
            (list spt cent ept)))
                ) ;; end of
) ;; end of progn

 ) ;; end of if
  (princ)
  ) ;; end of sap

 

[ScottMC]

Actually, here's one from ribarm https://www.theswamp.org/index.php?topic=42162.msg473601#msg473601 which really works so good! Just had to shop a little harder. Still need to calcumulate how to refuse non-bulge selection... Thanks much Marco
<<my micro variation>>

Code: [Select]

(vl-load-com) ;; https://www.theswamp.org/index.php?topic=42162.msg473601#msg473601
(defun c:pac ( / e ent pt p p1 p2 bulge rad cen fpt)
(setq e (entsel "\nPick Poly-ARC for Center + <Cal-Data>"))
(setq ent (car e) pt (cadr e))
(setq p (vlax-curve-getclosestpointto ent pt))
(setq p1 (vlax-curve-getpointatparam ent (float (fix (vlax-curve-getparamatpoint ent p)))))
(setq p2 (vlax-curve-getpointatparam ent (float (1+ (fix (vlax-curve-getparamatpoint ent p))))))
(setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float (fix (vlax-curve-getparamatpoint ent p)))))
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
(setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
;(alert (strcat "\nRadius of arc is : " (rtos (abs rad))
    ;                    "\nCenter of arc is : " (rtos (car cen)) "," (rtos (cadr cen)) "," (rtos (caddr cen))
    ;                    "\nAngle of arc is : " (rtos (cvunit (* 4 (atan bulge)) "radians" "degrees"))))
(princ (strcat "\nRadius of ARC is : " (rtos (abs rad))
                        "\nCenter of ARC is : " (rtos (car cen)) "," (rtos (cadr cen)) "," (rtos (caddr cen))
                           "\nAngle of ARC is : " (rtos (cvunit (* 4 (atan bulge)) "radians" "degrees"))"\n"))

        (setq fpt (strcat
            (rtos (car cen) 2 15) ","
            (rtos (cadr cen) 2 15) ","
            (rtos (caddr cen) 2 15))
          )
        (vl-cmdf "_point" fpt)
    (princ)
)



[Tharwat]

Here is a way to force the selection to select only LWpolyline with arc ( bugle segment ).

Code - Auto/Visual Lisp: [Select]

1. (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (-4 . "<>") (42 . 0.0)))
2.  

[kirby]

Bulge = 0.0 for a line segment, so just add an exception to skip calculation if you pick a line segment

(apologies to Marco Ribar for modifying his code)

Code - Auto/Visual Lisp: [Select]

1. (defun c:pac ( /
2.                 e ent pt p p1 p2 bulge rad cen fpt MyParam
3.                 )
4. ; Pick polyarc and get radius and delta angle of polyarc, by Marco Ribar
5. ; Original code
6. ; https://www.theswamp.org/index.php?topic=42162.msg473601#msg473601
7. ; Mentioned here
8. ; htps://www.theswamp.org/index.php?topic=57529.0
9.  
10. (setq e (entsel "\nPick Poly-ARC for Center + <Cal-Data>"))
11.  
12. (setq ent (car e) pt (cadr e))
13. (setq p (vlax-curve-getclosestpointto ent pt))
14.  
15. (setq MyParam (vlax-curve-getparamatpoint ent p))
16. (prompt "\n  Param at point = ")(princ MyParam)(princ)
17.  
18. (setq p1 (vlax-curve-getpointatparam ent (float (fix (vlax-curve-getparamatpoint ent p)))))
19. (setq p2 (vlax-curve-getpointatparam ent (float (1+ (fix (vlax-curve-getparamatpoint ent p))))))
20. (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float (fix (vlax-curve-getparamatpoint ent p)))))
21.  
22. (if (not (equal bulge 0.0 1e-8))
23.   (progn
24.         ; buldge not 0.0
25.         (setq rad (/ (distance p1 p2) (* 2.0 (sin (* 2.0 (atan bulge))))))
26.  
27.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2.0 (atan bulge)))) rad))
28.  
29.         ;(alert (strcat "\nRadius of arc is : " (rtos (abs rad))
30.         ;                    "\nCenter of arc is : " (rtos (car cen)) "," (rtos (cadr cen)) "," (rtos (caddr cen))
31.         ;                    "\nAngle of arc is : " (rtos (cvunit (* 4 (atan bulge)) "radians" "degrees"))))
32.         (princ (strcat "\nRadius of ARC is : " (rtos (abs rad))
33.                         "\nCenter of ARC is : " (rtos (car cen)) ", " (rtos (cadr cen)) ", " (rtos (caddr cen))
34.                            "\nAngle of ARC is : " (rtos (cvunit (* 4 (atan bulge)) "radians" "degrees")) " degrees\n"))
35.        
36.         (setq fpt (strcat
37.             (rtos (car cen) 2 15) ","
38.             (rtos (cadr cen) 2 15) ","
39.             (rtos (caddr cen) 2 15))
40.         )
41.         (vl-cmdf "_point" fpt)          ; point on centre
42.        
43.         (command "_line" P1 Cen P2 "")  ; radials
44.  
45.   )
46.   (progn
47.         (prompt "\n  Not a polyarc.  Try again.")
48.         (princ)
49.   )
50. )
51. (princ)
52. )
53.  
54.  

[ScottMC]

kirby  THANKS!!! you have my attention!! I've been learning,
as needed, just by looking for the solution. I'm gonna
scour your code completely! BTW.. Added a (c:pac)
at the progn near the bottom to allow it to loop. THANKS!!!

[kirby]

Happy to help

Try wrapping your code in a (while or other) loop to handle the repetitions inside the program without restarting

Cheezy example includes:
1. Main / Outer loop (to handle repetition)
2. Inner loop (routine selects an entity)
    a) Success condition
    b) fail condition, that gives up after a set number of failures
3. Option to continue or quit the main/outer loop
4. Report something to user at end

Also try to think about chunks of your code that you can reuse, these might be good candidates to split off into a separate routine.

Code - Auto/Visual Lisp: [Select]

1. (defun C:TestLooper ( /
2.                 SuccessCount FailCount MaxFail k k1 MySel MyEnt MySelPoint MyEntType StopMe
3.                 )
4. ; Program control loop example
5. ; KJM - April 2022
6.  
7. (setq SuccessCount 0)   ; initialize count of sucessful attempts
8. (setq FailCount 0)      ; initialize count of failed attempts
9. (setq MaxFail 3)        ; set maximum number of failures until we give up
10.  
11. (setq k 1)
12. (while k        ; Outer loop to repeat routine
13.  
14.        
15.         ; Inner loop to capture errors, bad or missed entity selection, etc
16.         (setq k1 1)
17.         (while k1
18.                 (setq MySel (entsel "\nSelect something..."))
19.                
20.                 (if MySel
21.                   (progn
22.                         ; Sucess, do stuff here....
23.                         (setq SuccessCount (1+ SuccessCount))
24.                        
25.                         (setq MyEnt (car MySel))
26.                         (setq MySelPoint (cadr MySel))
27.                
28.                         (setq MyEntType (strcase (cdr (assoc 0 (entget MyEnt)))))
29.                
30.                         (prompt "\n  Selected: ")(princ MyEntType)(princ)
31.                                
32.                         (setq k1 nil)   ; stop inner loop
33.                         (setq FailCount 0)      ; reset fail counter
34.                        
35.                   )    
36.                   (progn
37.                         ; Failure
38.                         (setq FailCount (1+ FailCount))
39.                        
40.                         (if (<= FailCount MaxFail)
41.                           (progn
42.                                 ; Less than or equal to maximum allowable failures
43.                                 (prompt "\n  You missed, try again...")(princ)
44.                           )
45.                           (progn
46.                                 ; Exceeded maximum allowable failures, give up
47.                                 (prompt "\n  Maybe today is not your day, bailing out...")(princ)
48.                                 (setq k1 nil k nil)     ; stop inner and outer loops
49.                           )
50.                         ) ; close if
51.                   )
52.                 ) ; close if
53.                
54.         ) ; close inner while  
55.  
56.  
57.         ; Continue or quit the outer loop
58.         (if k
59.           (progn
60.                 (setq StopMe (strcase (substr (getstring "\nE to end or any key to continue...") 1 1)))
61.                 (if (eq StopMe "E")
62.                   (progn
63.                         (setq k nil)    ; stop loop
64.                         (prompt "\n  Terminating...")(princ)
65.                   )
66.                 ) ; close if
67.           )
68.         ) ; close if
69.  
70. ) ; close outer while
71.  
72. ; Give user some feedback
73. (prompt "\nCompleted!  Successful selections = ")(princ SuccessCount)
74. (princ)
75. )
76.  

[d2010]

Dear ..
You upload a sample Drawing.dwg with your LwpolylineBulgeArc .
or 3DPolyBulgeArc?
We need this sample.
 

Hoping to find a solution [I've tried ] to filter, or something, a selection of a poly-arc to get the center and radius. This code gets it but errors-out when not picking an arc segment. Additionally a loop to solve the selection and multiple use of it would be helpful. ANY ideas/changes to this lsp I found will be appreciated!

Code: [Select]

;;  http://forums.autodesk.com/autodesk/attachments/autodesk/130/225916/1/Bulge-Center.txt

;by Fatty The Old Stupid Horse
;; helper functions ;;
;; group list in sublists
 
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
(repeat num (setq ls
    (cons (car lst) ls)
      lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
      ls nil)))
    )
ret
  );+
 
;get polyline vertices
 
(defun get-vexs (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
    verts
  (cond
    ((wcmatch (vlax-get pline_obj 'Objectname )
     "AcDb2dPolyline,AcDb3dPolyline")
     (group-by-num verts 3)
    )
    ((eq (vlax-get pline_obj 'Objectname )
     "AcDbPolyline")
     (group-by-num verts 2)
    )
    (T nil)
  )
        )
  );+
;; get bulge radius
;; math by Juergen Menzi
(defun get-radii  (p1 p2 bulge)
       (abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2)))) ;; crashed here from lack of arc selection
  );+

;;get segment arc center
;;math by John Uhden
(defun get-segm-center  (pline p1 p2 bulge / cpt midc midp rad)
(setq rad (get-radii p1 p2 bulge)
      midp (vlax-curve-getpointatparam pline
       (+ (fix (vlax-curve-getparamatpoint pline p1)) 0.5))
      midc (mapcar (function (lambda (x y)(/ (+ x y) 2))) p1 p2)
      cpt (trans (polar midp (angle midp midc) rad) 0 1)
)
cpt
);+

;main part;; Vertex of Polyline Arc Segment:
(defun C:SAP (/ *error* bpt bulg cent coors ent ept
                            pln rad segm snap_pt spt) ;;
(vl-load-com)

  (setq pln
   
            (vlax-ename->vla-object
          (car (setq ent
               
        (entsel "\n   Polyline Vertex of Polyline Arc Segment:\n  Select Arc of Polyline:"))
               
                 )))

(setq snap_pt (trans (cadr ent) 1 0)
      bpt (vlax-curve-getclosestpointto pln snap_pt))
(if (eq (vla-get-Closed pln) :vlax-false)
    (setq coors (get-vexs pln))
    (progn (setq coors (get-vexs pln))
   (setq coors (append coors (list (car coors))))))
(setq segm (fix (vlax-curve-getparamatpoint pln bpt))
      spt (nth segm coors)
      ept (nth (1+ segm) coors)
      bulg (vla-getbulge pln segm)
      rad (get-radii spt ept bulg)
      cent (trans (get-segm-center pln spt ept bulg) 1 0))
     
(princ (strcat "   Radius: " (rtos rad)))

(if (= bulg nil)  (princ "\n Straight Segment Selected.") )

 (if  (not (= bulg nil))
    (progn
 
;TesT Adds circle from arc selected
; (vlax-invoke (vla-get-modelspace
       ; (vla-get-activedocument
; (vlax-get-acad-object)))
 ; 'Addcircle cent rad)
 
(vlax-invoke (vla-get-modelspace
       (vla-get-activedocument
(vlax-get-acad-object)))
  'AddLightWeightPolyline
  (apply 'append (mapcar (function (lambda(x)
    (list (car x)(cadr x))))
            (list spt cent ept)))
                ) ;; end of
) ;; end of progn

 ) ;; end of if
  (princ)
  ) ;; end of sap

 

[kdub_nz]

d2010,
Perhaps do one for yourself by drawing a 2 legged polyline and FILLET the corner with a radius.

[ScottMC]

Have not spent adequate time yet on the characteristics of polylines but at times the center snaps don't exist. [ running A2K ] One day I'll dig into the DXF of one when it fails. '..it's one thing to taste the cookies.. it's much more to actually understand the recipe.. Still, thanks again kirby!

[ScottMC]

Breaking news.. Open polyline with arc segments prefer to decline their center osnap BUT when polyline is closed, it seems to work better!! One I must remember to put in my mental SSD.

[kdub_nz]

Breaking news.. Open polyline with arc segments prefer to decline their center osnap BUT when polyline is closed, it seems to work better!! One I must remember to put in my mental SSD.

Interesting . . .

Manual  or in code ?
Manual works for both in ac2023 ; haven't tried in code.