get polyline segment radius

[robert06]

Hi,

I'd like to get polyline segment radius as an argument by picking the segment of polyline or arc

(setq
aobj (car (entsel "\nSelect curve:\n"))
vobj (vlax-ename->vla-object aobj)
rad (vlax-get-property vobj 'Radius)
)

This works only with arcs & circles..

[marko_ribar]

Look into (_plsegrad) subfunction from this post :

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-help-for-dimension-angle-and-rad...

HTH, M.R.

[CADaSchtroumpf]

Hi,

An old program.

It's working with ARC, CIRCLE and old or new POLYLINE.

(defun near_vertex_arr (obj / dxf_obj l_10 l_40 l_41 l_42 dxf_39 e_next dxf_next dxf_43 dxf_38 obj_vlax pt_sel par pt_first pt_snd i bulge)
    (setq dxf_obj (entget (car obj)) l_10 nil l_40 nil l_41 nil l_42 nil)
    (cond
        ((eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
            (if (cdr (assoc 39 dxf_obj))
                (setq dxf_39 (cdr (assoc 39 dxf_obj)))
                (setq dxf_39 0.0)
            )
            (setq e_next (entnext (car obj)))
            (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
                (if (zerop (boole 1 (cdr (assoc 70 dxf_next)) 16))
                    (setq
                        l_10 (cons (cdr (assoc 10 dxf_next)) l_10)
                        l_40 (cons (cdr (assoc 40 dxf_next)) l_40)
                        l_41 (cons (cdr (assoc 41 dxf_next)) l_41)
                        l_42 (cons (cdr (assoc 42 dxf_next)) l_42)
                    )
                )
                (setq e_next (entnext e_next))
            )
            (setq
                l_10 (reverse l_10)
                l_40 (reverse l_40)
                l_41 (reverse l_41)
                l_42 (mapcar '(lambda (x) (cons 42 x)) (reverse l_42))
            )
            (if (and (equal (apply 'max l_40) (apply 'min l_40)) (equal (apply 'max l_41) (apply 'min l_41)))
                (setq dxf_43 (car l_40) l_40 nil l_41 nil)
                (setq
                    dxf_43 nil
                    l_40 (mapcar '(lambda (x) (cons 40 x)) l_40)
                    l_41 (mapcar '(lambda (x) (cons 41 x)) l_41)
                )
            )
            (if (not (zerop (caddar l_10)))
                (setq dxf_38 (caddar l_10))
                (setq dxf_38 0.0)
            )
            (setq l_10 (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) l_10))
            (entdel (car obj))
            (entmake
                (append
                    (list
                        (cons 0 "LWPOLYLINE")
                        (cons 100 "AcDbEntity")
                        (assoc 67 dxf_obj)
                        (assoc 410 dxf_obj)
                        (assoc 8 dxf_obj)
                        (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
                        (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
                        (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
                        (cons 100 "AcDbPolyline")
                        (cons 90 (length l_10))
                        (cons 70
                            (if (zerop (boole 1 (rem (cdr (assoc 70 dxf_obj)) 128) 1))
                                (boole 1 (cdr (assoc 70 dxf_obj)) 128)
                                (1+ (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                            )
                        )
                        (cons 38 dxf_38)
                        (cons 39 dxf_39)
                    )
                    (if (and l_40 l_41)
                        (apply 'append
                            (mapcar
                                '(lambda (x10 x40 x41 x42)
                                    (append (list x10 x40 x41 x42))
                                )
                                l_10 l_40 l_41 l_42
                            )
                        )
                        (progn
                            (cons 43 dxf_43)
                            (apply 'append
                                (mapcar
                                    '(lambda (x10 x42)
                                        (list x10 x42)
                                    )
                                    l_10 l_42
                                )
                            )
                        )
                    )
                    (list (assoc 210 dxf_obj))
                )
            )
            (setq obj (cons (entlast) (list (cadr obj))) dxf_obj (entget (car obj)))
        )
        (T (entupd (car obj)))
    )
    (vl-load-com)
    (setq
        obj_vlax (vlax-ename->vla-object (car obj))
        pt_sel (osnap (cadr obj) "_near")
    )
    (if (null pt_sel)
        (progn
            (while (null (setq e_next (entsel "\nDétermination du segment imprécise, resélectionnez: "))))
            (setq pt_sel (osnap (cadr e_next) "_near"))
        )
    )
    (setq
        pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans pt_sel 1 0))
        par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
        pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
        pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 0 1)
        i 0
    )
    (while (or (/= (caar dxf_obj) 42) (if (< i (fix par)) (setq i (1+ i))))
        (setq bulge (cdadr dxf_obj) dxf_obj (cdr dxf_obj))
    )
    (list pt_first pt_snd bulge)
)
(defun c:q_ray ( / old_osmd pt_sel ent dxf_ent typ_ent id_rad l_2pt)
    (setvar "cmdecho" 0)
    (while (not (setq ent (entsel "\nInterroger le rayon du segment arrondi: "))))
    (setq dxf_ent (entget (car ent)) typ_ent (cdr (assoc 0 dxf_ent)))
    (cond
        ((or (eq typ_ent "ARC") (eq typ_ent "CIRCLE"))
            (setq id_rad (cdr (assoc 40 dxf_ent)))
        )
        ((or (eq typ_ent "LWPOLYLINE")
            (and
                (eq typ_ent "POLYLINE")
                (zerop (boole 1 120 (cdr (assoc 70 dxf_ent))))
            )
        )
            (setq l_2pt (near_vertex_arr ent))
            (if (zerop (caddr l_2pt))
                (progn
                    (setq id_rad nil)
                    (princ "\nCe segment est droit et ne peut être interrogé!")
                )
                (setq id_rad (/ (distance (car l_2pt) (cadr l_2pt)) (sin (* 2.0 (atan (caddr l_2pt)))) 2.0))
            )
        )
        (T
            (setq id_rad nil)
            (princ "\nCet objet ne peut être interrogé!")
        )
    )
    (if (eq (type id_rad) 'REAL)
        (progn
            (alert
                (strcat
                    "\nRayon = "
                    (rtos (abs id_rad) 2 3)
                )
            )
            (princ
                (strcat
                    "\nRayon = "
                    (rtos (abs id_rad) 2 3)
                )
            )
        )
    )
    (setvar "cmdecho" 1)
    (princ)
)

[robert06]

sorry, i'm not sure how to turn to the subfunction

(setq
aobj (car (entsel "\nSelect curve:\n"))
vobj (vlax-ename->vla-object aobj)
rad (_plsegrad ....)
)

(defun _plsegrad ( obj pt / n p1 p2 bulge rad )
    (setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pt))))
    (setq p1 (vlax-curve-getpointatparam obj (float n)))
    (setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
    (setq bulge (vla-getbulge obj (float n)))
    (if (/= bulge 0.0)
      (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
    )
    (abs rad)
  )

[phanaem]

A simple way to get polyline's radius

(defun get_radius (e p)
  (distance
    '(0 0 0)
    (vlax-curve-getsecondderiv e
      (vlax-curve-getparamatpoint e
        (vlax-curve-getclosestpointto e p)
      )
    )
  )
)

And here is a test function, using the same principle.

(defun C:RADIUS (/ e)
  (setvar 'errno 0)
  (while
    (or
      (setq e (entsel "\nSelect a circle, arc or polyline: "))
      (= (getvar 'errno) 7)
    )
    (if
      (and e (wcmatch (cdr (assoc 0 (entget (car e))))  "CIRCLE,ARC,*POLYLINE"))
      (print
        (distance
          '(0 0 0)
          (vlax-curve-getsecondderiv (car e)
            (vlax-curve-getparamatpoint (car e)
              (vlax-curve-getclosestpointto (car e) (cadr e))
            )
          )
        )
      )
      (princ "\nInvalid object.")
    )
    (setvar 'errno 0)
  )
  (princ)
)

[CADaSchtroumpf]

Good point phanaem, thank!

But if I use pedit and fit a lwpolyline, it don't work at every time ?!?!

I can obtain:

Command:  RADIUS
Select a circle, arc or polyline: ; erreur: type d'argument incorrect: numberp: nil

You know why?

[EDIT]

This is occured then I works with many number in coordinates. ex: 15666478.23,9853647.21 etc...

[Kent1Cooper]

---

@robert06 wrote:

.... 

I'd like to get polyline segment radius as an argument by picking the segment of polyline or arc

....

---

Here's the command I've used for years:

(defun C:RAD (/ pt); report RADius of curve
  ; [e.g. Polyline Arc segment, whose radius does not appear in Properties box or List result]
  (setq aper (getvar 'aperture))
  (while
    (not (setq pt (cadr (entsel "Select curve: "))))
    (prompt "\nNothing selected -- ")
  ); end while
  (setvar 'aperture (getvar 'pickbox))
  (if (osnap pt "cen")
    (prompt (strcat "\nRadius is " (rtos (distance (osnap pt "nea") (osnap pt "cen"))) "."))
    (prompt "\nNo radius for that object.")
  ); end if
  (setvar 'aperture aper)
  (princ)
)

You could have it not just report the radius, but also save it to a variable:

....

  (if (osnap pt "cen")
    (prompt (strcat "\nRadius is " (rtos (setq rad (distance (osnap pt "nea") (osnap pt "cen")))) "."))
    (prompt "\nNo radius for that object.")
  ); end if

....

It works on not only Circles, Arcs, and Polyline arc segments, but even edges of 3DSolids and Regions that were generated from those, and the dimension-line arcs of angular Dimensions [as if you'd ever want to know the radius of one of those...].  And it rejects fit-curved or spline-curved Polylines.  However, it will also report a "radius" for an Ellipse, which will vary depending on where you pick it.  I have a way to prevent that, worked out in a different routine, that I haven't incorporated into this one yet, but some time soon....

[phanaem]

I don't know what is the error, but these polyline must be filtered out. The lisp should return a value on polylines like this, but is not the radius. It can be the local curvature, but I didn't checked.

[robert06]

Thank you all, I used Kent Cooper's version

(defun c:fsr ( / pt rad) ;; Fillet with radius from picked curve
(setq pt (cadr (entsel "Select curve: ")))
(if (osnap pt "cen")
    (prompt (strcat "\nRadius is " (rtos (setq rad (distance (osnap pt "nea") (osnap pt "cen")))) "."))
    (prompt "\nNo radius for that object.")
  ); end if

(setvar "cmdecho" 0)
(command "filletrad" rad)
(setvar "cmdecho" 1)
(terpri)
(command "_.fillet" pause pause)
(princ)
)

[Kent1Cooper]

---

@robert06 wrote:

... ;; Fillet with radius from picked curve
....

---

If you'd let on that's what you were going to use it for, I could have directly supplied the attached FilletMatchRad.lsp with its FMR command.  It's quite similar to yours, obviously, but also has an error handler and a little "insurance" that the detected center of the curve is of the right curve, if there might be any others in the vicinity.  And it lets you Fillet as many things at that radius as you want [not just once], all in one running of the command.

[robert06]

Thank you, Kent, as it's more advanced than my lispy, i'll use FMR.

[Kent1Cooper]

---

@Kent1Cooper wrote:

If you'd let on that's what you were going to use it for, I could have directly supplied the attached FilletMatchRad.lsp with its FMR command.  ....

---

A remarkable coincidence:  I had recently sent that routine in to the Cadalyst CAD Tips website, and after poking around here, I went over there, and lo and behold, today they have put it up as Tip #4458.

[CADaSchtroumpf]

I think that vlax-curve-getclosestpointto don't work properly with the old polyline and greatest coordinates (when i fit a Lwpolyline, this became an old polyline)

I have encountered some problem before in other case with vlax-curve-getclosestpointto: it don't return a point but nil, if I move near to 0,0 it can find it.

[robert06]

Good for you, Kent, the lisp is worth recognition 🙂

I did not post 'accepted as solution' with this thread, as other versions posted might work as well getting the segment radius, just could not test all of those.

Robert

[phanaem]

---

@CADaSchtroumpf wrote:

I think that vlax-curve-getclosestpointto don't work properly with the old polyline and greatest coordinates (when i fit a Lwpolyline, this became an old polyline)

I have encountered some problem before in other case with vlax-curve-getclosestpointto: it don't return a point but nil, if I move near to 0,0 it can find it.

---

Yes, sometimes vlax-curve functions act like this. I think it is a rounding issue.

Try this new version. It works with plane polylines (meaning not 3D rotated).

(defun C:RADIUS (/ d e el)
  (setvar 'errno 0)
  (while
    (or
      (setq e (entsel "\nSelect a circle, arc or polyline: "))
      (= (getvar 'errno) 7)
    )
    (if
      (and
        e
        (wcmatch (cdr (assoc 0 (setq el (entget (car e)))))  "CIRCLE,ARC,*POLYLINE")
        (or
          (not (setq d (cdr (assoc 70 el))))
          (zerop (logand d (+ 4 8 16 64)))
        )
      )
      (print (getrad (car e) (cadr e)))
      (princ "\nInvalid object.")
    )
    (setvar 'errno 0)
  )
  (princ)
)

(defun getrad (e p / r)
  (if
    (not
      (vl-catch-all-error-p
        (setq r
          (vl-catch-all-apply
            (function
              (lambda nil
                (distance
                  '(0 0 0)
                  (vlax-curve-getsecondderiv e
                    (vlax-curve-getparamatpoint e
                      (vlax-curve-getclosestpointtoprojection e
                        (trans p 1 0) (trans (getvar 'viewdir) 1 0 T)
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    r
    (not (princ (strcat "\nError: " (vl-catch-all-error-message r))))
   )
 )

[CADaSchtroumpf]

For me, is not better.

For illustrating the problem, try with this simple entitie.

(foreach n
'(
(
(0 . "POLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDb2dPolyline")
(66 . 1)
(10 0.0 0.0 0.0)
(70 . 2)
(40 . 0.0)
(41 . 0.0)
(210 0.0 0.0 1.0)
(71 . 0)
(72 . 0)
(73 . 0)
(74 . 0)
(75 . 0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 660867.0 6.42101e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.28741)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 670003.0 6.46973e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.309998)
(91 . 0)
(70 . 1)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 715363.0 6.48008e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.453255)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 727466.0 6.44619e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.528215)
(91 . 0)
(70 . 1)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 742124.0 6.41688e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.542259)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 762123.0 6.44005e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.536005)
(91 . 0)
(70 . 1)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 782022.0 6.46355e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.244767)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 796073.0 6.45403e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.227579)
(91 . 0)
(70 . 1)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 810730.0 6.44338e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.356781)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 837965.0 6.45842e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.355991)
(91 . 0)
(70 . 1)
(50 . 0.0)
)
(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 865225.0 6.47352e+006 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.377533)
(91 . 0)
(70 . 0)
(50 . 0.0)
)
(
(0 . "SEQEND")
(67 . 0)
(410 . "Model")
(8 . "0")
)
)
(entmake n)
)

 Paste it directly in command line and make zoom extent.

My version Q_RAY work's with this, and also FMR of Kent (if I add underscore to the option of the (osnap) function "_near"  for french version)

[phanaem]

It works here. Tests made in A2014 and A2015, no problem found.
Anyway, since your lisp works, I don't see any reason to discuss any further on my lisp.
If you are looking for something else, please open a new topic.

[CADaSchtroumpf]

In Autocad Map 3D 2014, work's sometime on vertex, for another one it don't work !!!!

I am only interested by your shortest solution, but this , for me, isn't always reliability.

Perhaps somebody else can be have an explanation of this fact.

Warmly

[CADaSchtroumpf]

I have finds a solution.

For greatest coordinates, object must be moved for (vlax-curve-getparamatpoint) return a value and not nil.

This always work.

(defun C:RADIUS (/ e vlaobj mkv vector)
  (setvar 'errno 0)
  (while
    (or
      (setq e (entsel "\nSelect a circle, arc or polyline: "))
      (= (getvar 'errno) 7)
    )
    (setq vlaobj (vlax-ename->vla-object (car e)))
    (if
      (and e (wcmatch (cdr (assoc 0 (entget (car e))))  "CIRCLE,ARC,*POLYLINE"))
      (progn
        (if (or (> (fix (car (trans (cadr e) 1 0))) 1E6) (> (fix (cadr (trans (cadr e) 1 0))) 1E6))
          (setq mkv T vector (trans (cadr e) 0 0 T))
          (setq mkv nil vector '(0.0 0.0 0.0))
        )
        (if mkv (vla-move vlaobj (vlax-3d-point (trans (cadr e) 1 0)) (vlax-3d-point '(0.0 0.0 0.0))))
        (print
          (distance
            '(0 0 0)
            (vlax-curve-getsecondderiv (car e)
              (vlax-curve-getparamatpoint (car e)
                (vlax-curve-getclosestpointto (car e) (if mkv '(0.0 0.0 0.0) (trans (cadr e) 1 0)))
              )
            )
          )
        )
        (if mkv (vla-move vlaobj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point vector)))
      )
      (princ "\nInvalid object.")
    )
    (setvar 'errno 0)
  )
  (princ)
)

 Thank for your time.