Problem getting the radius of an arc segment from an exploded polyline

jakob.holmquistGRCUL · ‎02-08-2022

Hello everyone!

Beginner here, and I'm stuck. I am trying to create a lisp where I want to find all arcs and/or arc segments (in all sort of polylines).

So basically the program should do this:

The user enters a radius, and then gets to select which objects to be included in the selection set. The lisp goes through all arcs and arc segments in the selection set, and for every instance where the arc/arc segment has equal radius to the user specified radius the lisp somehow shows that the given arc/arc segment is a match (I haven't figured how the lisp should show it, but for example it could create a circle around each arc/arc segment that is a match as I've coded it now).

I have tried writing my own code as well as copy/pasting from different lisps I have found, but there seems to be a problem. For arcs it works perfectly, but when I am trying to find the radius of an arc segment of a *polyline the lisp fails: "Error: ActiveX Server returned the error: unknown name: "RADIUS" ". The polyline gets exploded but I believe fails to execute the test if the current segment of the polyline is an arc. Is my lisp trying to find the radius of a line or why does it not find the radius of the arc segments?

Any help is appreciated!

(defun c:ksr 
(/ *error*)
	
	(defun *error* (msg)
		(if	(not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(if	acdoc
			(vla-endundomark acdoc)
		)
		(princ)
	)
(defun LM:roundm ( n m )(* m (atoi (rtos (/ n (float m)) 2 0))))
;(setq selectedRadius (getreal"\nEnter radius: "))
(setq selectedRadius 15) ;for testing only to avoid having to type in radius every test
(print selectedRadius) ;just to see if the lisp manages to function this far

(prompt "\nSelect objects in layer M-DEC---E1N")
(setq ss (ssget '((0 . "ARC,LWPOLYLINE,POLYLINE,2DPOLYLINE,3DPOLYLINE") (8 . "M-DEC---E1N"))) i  -1)
(print ss) ;just to see if the lisp manages to function this far
	(while (< (setq i (1+ i)) (sslength ss))
		(setq to (vlax-ename->vla-object (ssname ss i)))
		(cond
			((= (vlax-get to 'objectname) "AcDbArc")
				;insert code what happens if object is arc
			 	;(print "arc") ;just for testing to check what happens when the condition is true
				(setq objectRadius (LM:roundm (vlax-get to 'radius) 0.05)
				      objectStartPoint (vlax-get to 'startpoint)
				      objectEndPoint (vlax-get to 'endpoint)
				)
			 	(if
				  	(= selectedRadius objectRadius)
						;(entmake '((0 . "CIRCLE") (62 . 1) (10 (vlax-get to 'startpoint)) (40 . 1.0)))
				  		(command "circle" "2p" objectStartPoint objectEndPoint)
					)
			);end condition arc
				
			((or (= (vlax-get to 'objectname) "AcDbPolyline")(= (vlax-get to 'objectname) "AcDb2dPolyline")(= (vlax-get to 'objectname) "AcDb3dPolyline"))
				(setq olst (vlax-invoke to 'explode))
				(foreach eo	olst
					(cond 
						
						((= (vlax-get eo 'objectname) "AcDbArc")
							(if 
								(= (vlax-get eo 'objectname) "AcDbArc")
								(setq 	objectRadius (LM:roundm (vlax-get to 'radius) 0.05)
				      					objectStartPoint (vlax-get to 'startpoint)
				      					objectEndPoint (vlax-get to 'endpoint)
								)
							)
							(if 
								(= selectedRadius objectRadius)
									(command "circle" "2p" objectStartPoint objectEndPoint)			
									 
							)
								
						)
					)
				)
				(mapcar 'vla-delete olst)
			);end condition arc segment
		);end cond
	); end while

(princ)

);end

ronjonp · ‎02-08-2022

@jakob.holmquistGRCUL

Try this ... it highlights arcs red that match rather than drawing circles.

(defun c:ksr (/ *error* acdoc i olst r selectedradius ss to)
  (defun *error* (msg)
    (if	(not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg))
    )
    (if	acdoc
      (vla-endundomark acdoc)
    )
    (princ)
  )
  (defun lm:roundm (n m) (* m (atoi (rtos (/ n (float m)) 2 0))))
					;(setq selectedRadius (getreal"\nEnter radius: "))
  (setq selectedradius 15)		;for testing only to avoid having to type in radius every test
  (print selectedradius)		;just to see if the lisp manages to function this far
  (prompt "\nSelect objects in layer M-DEC---E1N")
  (setq	ss (ssget '((0 . "ARC,*POLYLINE") (8 . "M-DEC---E1N")))
	i  -1
  )
  (print ss)				;just to see if the lisp manages to function this far
  (while (< (setq i (1+ i)) (sslength ss))
    (setq to (vlax-ename->vla-object (ssname ss i)))
    (cond ((= (vlax-get to 'objectname) "AcDbArc") ;insert code what happens if object is arc
					;(print "arc") ;just for testing to check what happens when the condition is true
	   (if (= selectedradius (lm:roundm (vlax-get to 'radius) 0.05))
	     (vla-put-color to 1)
	   )
	  )				;end condition arc
	  ((wcmatch (vlax-get to 'objectname) "*Polyline")
	   (foreach eo (setq olst (vlax-invoke to 'explode))
	     (cond ((= (vlax-get eo 'objectname) "AcDbArc")
		    (if	(= selectedradius (lm:roundm (vlax-get eo 'radius) 0.05))
		      ;; We have a match! Remove from 'olst' and color red
		      (progn (setq olst (vl-remove eo olst)) (vla-put-color eo 1))
		    )
		   )
	     )
	   )
	   (mapcar 'vla-delete olst)
	  )				;end condition arc segment
    )					;end cond
  )					; end while
  (princ)
)					;end

devitg · ‎02-08-2022

@jakob.holmquistGRCUL please test it for simple arcs , no others ent that could hold radius property

Also find attached , a before and after dwg

;;;;-*******************************************************************************************************************************
;************************************************************

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2022 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;
; ----------------------------------------------------------------------
; DISCLAIMER:  Gabriel Calos De Vit Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold Gabriel Calos De Vit harmless from such claims.
; Gabriel Calos De Vit makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------


;;************************************************************


;;;get-same-radius-arcs

;;;*************************************************************;;;


(defun get-same-radius-arcs (/
                             ACAD-OBJ
                               acRed ADOC ARC-ENT-SS ARC-OBJ-SS ARC-RAD LAY-COLL MODEL
                               SELECTEDRADIUS SELECTIONSETS
                                                   )
  
  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  (SETQ SELECTIONSETS (VLA-GET-SELECTIONSETS ADOC))
  (setq lay-coll (VLA-GET-LAYERS adoc))

  (if (not (setq selectedRadius (getreal "\nEnter radius: ")))
    (setq selectedRadius 15.0) ;for testing only to avoid having to type in radius every test
  ) ;_  if
  (print selectedRadius) ;just to see if the lisp manages to function this far

  (if (setq arc-ent-ss (ssget "X" '((0 . "ARC") (8 . "0"))))
    (progn
      (setq arc-obj-ss (VLA-GET-ACTIVESELECTIONSET adoc)) ; convert all ent-ss to obj-ss
      (VLAX-for
             arc-obj
                    arc-obj-ss
        (if (eq (setq arc-rad (VLA-GET-RADIUS arc-obj)) selectedRadius   )
          (vla-put-color arc-obj 1)
        ) ;_  if 
      ) ;_  VLAX-for
    ) ;end progn
    (alert "\n There are no arcs here")
  ) ;en if ss 
) ; end

(defun c:get=arc ()
(get-same-radius-arcs)
  )

john.uhden · ‎02-08-2022

@ronjonp

Are you once again exploding things without gluing them back together?

Might I recommend exploding a vla-copy instead?

Of course I'm so stuck in my tedious ways that I would solve each segment for its radius, but then how does one highlight one segment of a polyline? Ans: One does not.

Which always made me wonder with old heavy polylines... why does each vertex have a layer and color (etc.) that is ignored?

I thought it would be cool to have a multi-layer and/or multi-color polyline. I mean attributes have their own personal characteristics, right? It must be descrimination! Vertex lives matter too, ya know.

John F. Uhden

ronjonp · ‎02-08-2022

@john.uhden wrote:

@ronjonp

Are you once again exploding things without gluing them back together?

Might I recommend exploding a vla-copy instead?

...

@john.uhden

Did you run the code? VLA-EXPLODE makes a copy of all the parts and the original is left intact.

What is left over is a marker of arcs that meet a certain condition.

john.uhden · ‎02-08-2022

@ronjonp

i did not know that about vla-explode Many thanks!

Of course, I would prefer to use (vlax-invoke obj 'explode) to get the list of new objects rather than all that variant + safearray crap.

You have really been helping me learn a lot!

John F. Uhden

CADaSchtroumpf · ‎02-09-2022

Just for find radius without explode or draw newentities.

If radius is find a vitual circle is draw (redess for clear)

(defun draw_circle (p_c rd / inc l)
  (setq inc (/ 18))
  (repeat 36
    (setq l (append l (list 1 (polar p_c inc rd) (polar p_c (setq inc (+ inc (/ pi 18))) rd))))
  )
  (grvecs l)
)
(defun c:ksr ( / js rad_x n ename obj typ_obj pr pt_cen rad dist_start dist_end pt_start pt_end  seg_len seg_bulge alpha)
  (princ "\nSelect objects in layer M-DEC---E1N")
  (setq js (ssget '((0 . "*POLYLINE,ARC,CIRCLE") (8 . "M-DEC---E1N") (-4 . "<NOT") (-4 . "&") (70 . 126) (-4 . "NOT>"))))
  (cond
    (js
      (initget 7)
      (setq rad_x (getdist "\nEnter radius to find?: "))
      (repeat (setq n (sslength js))
        (setq
          ename (ssname js (setq n (1- n)))
          obj (vlax-ename->vla-object ename)
          typ_obj (vla-get-ObjectName obj)
          pr -1
        )
        (if (member typ_obj '("AcDbArc" "AcDbCircle"))
          (progn
            (setq
              pt_cen (vlax-get obj 'Center)
              rad (vlax-get obj 'Radius)
            )
            (if (equal rad rad_x 1E-08) (draw_circle pt_cen rad))
          )
          (repeat (fix (vlax-curve-getEndParam obj))
            (setq
              dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
              dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
              pt_start (vlax-curve-GetPointAtParam obj pr)
              pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
              seg_len (- dist_end dist_start)
              seg_bulge (vla-GetBulge obj pr)
            )
            (if (not (zerop seg_bulge))
              (progn
                (setq
                  rad (/ seg_len (* 4.0 (atan seg_bulge)))
                  alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
                  pt_cen (polar pt_start alpha rad)
                )
                (if (equal rad rad_x 1E-08) (draw_circle pt_cen rad))
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)

ronjonp · ‎02-09-2022

@john.uhden wrote:

@ronjonp

i did not know that about vla-explode Many thanks!

Of course, I would prefer to use (vlax-invoke obj 'explode) to get the list of new objects rather than all that variant + safearray crap.

You have really been helping me learn a lot!

Glad to help! *beersclinkingwithmugs*

Sea-Haven · ‎02-09-2022

removed

ВeekeeCZ · ‎02-10-2022

HERE is a nice explanation from Lee Mac.

Kent1Cooper · ‎02-10-2022

Here's my take on it -- the ArcID command in the attached ArcID.lsp. It puts a Point object at the midpoint of all Arcs or Polyline arc segments with the specified radius [within tolerance]. It could be made to put them on a specific Layer, or give them a noticeable color, etc. It doesn't require Exploding anything or drawing anything temporary, it works with any variety of Polyline(s), and it remembers your target radius and offers it as default on subsequent use. It has the possibility, under just the wrong circumstances [something else with a CENter, and of smaller radius than a Polyline arc segment and crossing it very close to its midpoint], that it will "see" the wrong center point and miss marking one that it should, or mark one that it shouldn't. That possibility is minimized by what it does with the Aperture setting, but it still exists. Lightly tested.

Kent Cooper, AIA

jakob.holmquistGRCUL · ‎02-15-2022

Sorry for the delay in response, but thank you to everyone for helping out! With your help I've managed to make the lisp work. I decided to still insert circles around the arcs to make them more visible, while also making the circles be created in a layer named after the specific radius the lisp searches for, so it's been a great learning experience for me. 🙂

Community

Problem getting the radius of an arc segment from an exploded polyline

Problem getting the radius of an arc segment from an exploded polyline

Problem getting the radius of an arc segment from an exploded polyline