Select similar closed polylines according to area (Lisp)

Select similar closed polylines according to area (Lisp)

Vinayv4v
Advisor Advisor
3,419 Views
9 Replies
Message 1 of 10

Select similar closed polylines according to area (Lisp)

Vinayv4v
Advisor
Advisor

Hi,

 

I need to select objects according to polyline area (only closed polylines).

My polylines has got an area from 1.6 to 1.8. I have this lisp from lee mac.

 

;; Select Similar Area - Lee Mac
;; Prompts the user to select a source polyline and
;; selects all polylines in the active layout with a similar area.

(defun c:ssarea ( / ent inc sel src )
(if
(and
(setq src
(LM:SelectIf "\nSelect Source Polyline: "
'(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE"))
)
)
(setq sel
(ssget "_X"
(list '(0 . "*POLYLINE")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(setq src (vla-get-area (vlax-ename->vla-object src)))
)
(repeat (setq inc (sslength sel))
(setq ent (ssname sel (setq inc (1- inc))))
(if (not (equal src (vla-get-area (vlax-ename->vla-object ent)) 1e-3))
(ssdel ent sel)
)
)
)
(sssetfirst nil sel)
(princ)
)

;; Select If - Lee Mac
;; Continuously prompts the user for a selection
;; until a given predicate function is validated

(defun LM:SelectIf ( msg prd / e )
(setq prd (eval prd))
(while
(progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, try again.")
)
( (eq 'ENAME (type e))
(if (and prd (null (prd e)))
(princ "\nInvalid Object.")
)
)
)
)
)
e
)

(vl-load-com) (princ)

 

1. What should be the precision value to get polyline from area 1.6 to 1.8.

I set the precision in units to 0 I am getting upto area=2.

 

2. When I am using this LISP open lines are also getting selected. I need only the closed ones.

 

lisp.JPG

Cheers,

Vinay Vijayakumaran

0 Likes
Accepted solutions (1)
3,420 Views
9 Replies
Replies (9)
Message 2 of 10

Anonymous
Not applicable
(defun c:ssarea ( / ent inc sel src ) 
(if
(and
(setq src
(LM:SelectIf "\nSelect Source Polyline: "
'(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE"))
)
)
(setq sel
(ssget "_X"
(list '(0 . "*POLYLINE")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(setq src (vla-get-area (vlax-ename->vla-object src)))
)
(repeat (setq inc (sslength sel))
(setq ent (ssname sel (setq inc (1- inc))))
(if (or (= :vlax-false (vla-get-closed (vlax-ename->vla-object ent))) (not (equal src (vla-get-area (vlax-ename->vla-object ent)) 1e-3)))
(ssdel ent sel)
)
)
)
(sssetfirst nil sel)
(princ)
)

;; Select If - Lee Mac
;; Continuously prompts the user for a selection
;; until a given predicate function is validated

(defun LM:SelectIf ( msg prd / e )
(setq prd (eval prd))
(while
(progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, try again.")
)
( (eq 'ENAME (type e))
(if (and prd (null (prd e)))
(princ "\nInvalid Object.")
)
)
)
)
)
e
)

(vl-load-com) (princ)
Message 3 of 10

ВeekeeCZ
Consultant
Consultant
Accepted solution

Try it like this... or it could be changed to prompt you for max and min of the range..

 

;; Select Similar Area - Lee Mac
;; Prompts the user to select a source polyline and
;; selects all polylines in the active layout with a similar area.

(defun c:ssarea ( / ent inc sel src prc)
  (if
    (and
;      (setq src
;	     (LM:SelectIf "\nSelect Source Polyline: "
;	       '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE"))
;	       )
;	    )
      (setq sel
	     (ssget "_X"
		    (list '(0 . "*POLYLINE")
			  '(-4 . "&")
			  '(70 . 1)
			  (if (= 1 (getvar 'cvport))
			    (cons 410 (getvar 'ctab))
			    '(410 . "Model")
			    )
			  )
		    )
	    )
      ;(setq src (vla-get-area (vlax-ename->vla-object src)))
      (setq src (getreal "\nArea: "))
      (setq prc (getreal "\nPrecision (0.1): "))
      )
    (repeat (setq inc (sslength sel))
      (setq ent (ssname sel (setq inc (1- inc))))
      (if (not (equal src (vla-get-area (vlax-ename->vla-object ent)) prc))
	(ssdel ent sel)
	)
      )
    )
  (sssetfirst nil sel)
  (princ)
  )

;; Select If - Lee Mac
;; Continuously prompts the user for a selection
;; until a given predicate function is validated

(defun LM:SelectIf ( msg prd / e )
  (setq prd (eval prd))
  (while
    (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
      (cond
	( (= 7 (getvar 'ERRNO))
	 (princ "\nMissed, try again.")
	 )
	( (eq 'ENAME (type e))
	 (if (and prd (null (prd e)))
	   (princ "\nInvalid Object.")
	   )
	 )
	)
      )
    )
  e
  )

(vl-load-com) (princ)

Edited. Try again.

Message 4 of 10

Vinayv4v
Advisor
Advisor

Sorry guys, both not working.

 

Here is the file attached.

 

 

Cheers,

Vinay Vijayakumaran

0 Likes
Message 5 of 10

stevor
Collaborator
Collaborator

'Sorry guys, both not working.'

 

Not working how?

What were the results that did not work?

 

S
0 Likes
Message 6 of 10

Vinayv4v
Advisor
Advisor

Thanks guys.

 

BeekeeCZ your edited one works like a charm.

Cheers,

Vinay Vijayakumaran

0 Likes
Message 7 of 10

john.uhden
Mentor
Mentor

Beekee:

 

I think your c:ssarea does not need the first if.  One long and will do.

John F. Uhden

0 Likes
Message 8 of 10

ВeekeeCZ
Consultant
Consultant

@john.uhden wrote:

Beekee:

 

I think your c:ssarea does not need the first if.  One long and will do.


John, thank you for your concerns.., but...

 

1) the code is not mine, I've made just necessary adjustments as was required

 

2) you know that I know this and sometimes I do even use it.

 

3) In general, I do prefer the traditional syntax (if (and (cond1 cond2)) then (do stuff...)) This is the way I've been taught (not LISP but even so), and I find it more clear not only to me by also for others, mostly beginners, hanging out around here... 

0 Likes
Message 9 of 10

john.uhden
Mentor
Mentor

I wasn't concerned at all unless if there were a condition that I should have been, in which case thank you for easing my angst.

John F. Uhden

0 Likes
Message 10 of 10

Lindsay-CAD
Contributor
Contributor

I see this conversation was in 2017. Hope you are still doing these things. I have a cad drawing which was exported from Tilt-Werkx. It's a dxf file and most of the objects are closed polylines. I need to insert dynamic blocks over these polylines. There are a number of different sized polyline boxes or rectangles, each is a different block. There could be hundreds of polylines. The ssarea routine will find the polylines. What I want to do is insert a block at the midpoint of the top or bottom line of the polyline depending on the area of the polyline. The Polylines are also on specific layers. My lisp skills are limited In my mind I need to find the midpoint between the bottom 2 corners or the midpoint between the top 2 corners. 

 

RobH

0 Likes