Found a Lisp that will filter lines with a length range

Found a Lisp that will filter lines with a length range

vporrash141089
Advocate Advocate
4,488 Views
9 Replies
Message 1 of 10

Found a Lisp that will filter lines with a length range

vporrash141089
Advocate
Advocate

Hello everyone,

Credit for this code as far as I know to Joe Burke, it was archived but still very useful so I thought I'd share and also request for help 🙂

 

You have no idea how this lisp is making my life easier, however if it does what it does I thought on some improvements that honestly I do not know how to add.

 

  • It is helping me select lines with a certain length range and this is awesome but I often need to apply the same length range to poly lines which it does not do.
  • Also it would be awesome to add the area filter to this code for poly lines for example:Enter minimum area value/ Enter Max area value and select entities and retrieve result.

If some can help with the updates to this file I will be very grateful and any guidance  will be very much appreciated

 

Joe Burke

;select lines by fixed length or within range
(defun c:SSLineLen ( / *Error* cnt ent fixlen len stpt enpt maxlen minlen
mode ss)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(initget 1 "R F ")
(setq MODE
(getkword "Select lines within (R)ange or (F)ixed length : "))
(if (or (= MODE "") (= MODE "F"))
(setq MODE "F")
) ;end if

(if (= MODE "F")
(setq FIXLEN (getdist "\nEnter fixed line length: "))
(progn
(setq MINLEN (getdist "\nEnter minimum length: "))
(setq MAXLEN (getdist "\nEnter maximum length: "))
) ;end progn else
) ;end if

(if (ssget "I")
(setq SS (ssget "I" (list (cons 0 "LINE"))))
(setq SS (ssget (list (cons 0 "LINE"))))) ;end if
(setq CNT 0)
(repeat (sslength SS)
(setq ENT (ssname SS CNT)
STPT (cdr (assoc 10 (entget ENT)))
ENPT (cdr (assoc 11 (entget ENT)))
LEN (distance STPT ENPT)
) ;end setq

(cond
((= MODE "F")
(if (equal FIXLEN LEN 0.00001)
(setq CNT (1+ CNT)) ;then next
(ssdel ENT SS) ;else delete
) ;end if
) ;end cond F

((= MODE "R")
(if
(or
(and (<= MINLEN LEN) (>= MAXLEN LEN))
(equal MINLEN LEN 0.00001)
(equal MAXLEN LEN 0.00001)
) ;end or
(setq CNT (1+ CNT))
(ssdel ENT SS)
) ;end if
) ;end cond R
) ;end conditions
) ;end repeat

(if (> (sslength SS) 0)
(progn
(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
(sssetfirst nil SS)
) ;progn
(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

0 Likes
Accepted solutions (2)
4,489 Views
9 Replies
Replies (9)
Message 2 of 10

dbhunia
Advisor
Advisor
Accepted solution

Hi

 


@vporrash141089 wrote:

 

.............................. 
  • It is helping me select lines with a certain length range and this is awesome but I often need to apply the same length range to poly lines which it does not do.
  • Also it would be awesome to add the area filter to this code for poly lines for example:Enter minimum area value/ Enter Max area value and select entities and retrieve result.

 

..........................



For the above requirement try this......

 

(defun c:SSLineLen ( / *Error* cnt ent fixlen len stpt enpt maxlen minlen
mode ss)
(vl-load-com)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(initget 1 "R F ")
(setq MODE
(getkword "Select lines within (R)ange or (F)ixed length : "))
(if (or (= MODE "") (= MODE "F"))
(setq MODE "F")
) ;end if

(if (= MODE "F")
(setq FIXLEN (getdist "\nEnter fixed line length: "))
(progn
(setq MINLEN (getdist "\nEnter minimum length: "))
(setq MAXLEN (getdist "\nEnter maximum length: "))
) ;end progn else
) ;end if

(if (ssget "I")
(setq SS (ssget "I" '((0 . "*LINE"))))
(setq SS (ssget '((0 . "*LINE"))))) ;end if
(setq CNT 0)
(repeat (sslength SS)

   	(setq ENT (ssname SS CNT)
      	   	;STPT (cdr (assoc 10 (entget ENT)))
		;ENPT (cdr (assoc 11 (entget ENT)))
		LEN (vla-get-length (vlax-ename->vla-object ENT))
   	) ;end setq

	(cond ((= MODE "F")
		(if (equal FIXLEN LEN 0.00001)
			(setq CNT (1+ CNT)) ;then next
			(ssdel ENT SS) ;else delete
		) ;end if
	      ) ;end cond F

	      ((= MODE "R")
		(if (or (and (<= MINLEN LEN) (>= MAXLEN LEN))
		        (equal MINLEN LEN 0.00001)
                        (equal MAXLEN LEN 0.00001)
		    ) ;end or
			(setq CNT (1+ CNT))
			(ssdel ENT SS)
		) ;end if
	      ) ;end cond R
	) ;end conditions
) ;end repeat

(if (> (sslength SS) 0)
(progn
(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
(sssetfirst nil SS)
) ;progn
(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
0 Likes
Message 3 of 10

dbhunia
Advisor
Advisor
Accepted solution

Hi

 


@vporrash141089 wrote:

 

........................

 

  • It is helping me select lines with a certain length range and this is awesome but I often need to apply the same length range to poly lines which it does not do.
  • Also it would be awesome to add the area filter to this code for poly lines for example:Enter minimum area value/ Enter Max area value and select entities and retrieve result.

 

.......................

 

For the above requirement try this...... (All the solutions are only modifications of your given Code)

 

(defun c:SSArea ( / *Error* CNT ENT AREA MINAREA MAXAREA ss StartPoint EndPoint)
(vl-load-com)
(command "cmdecho" 0)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(setq MINAREA (getdist "\nEnter minimum area value: "))
(setq MAXAREA (getdist "\nEnter maximum area value: "))

(if (ssget "I")
	(setq SS (ssget "I" '((0 . "LWPOLYLINE"))))
	(setq SS (ssget '((0 . "LWPOLYLINE"))))
) ;end if

(setq CNT 0)
(repeat (sslength SS)

   	(setq ENT (ssname SS CNT)
	      AREA (vla-get-area (vlax-ename->vla-object ENT))
	      StartPoint (vlax-curve-getStartPoint (vlax-ename->vla-object ENT))
	      EndPoint (vlax-curve-getEndPoint (vlax-ename->vla-object ENT))
   	) ;end setq

	(if (or (and (<= MINAREA AREA) (>= MAXAREA AREA) (equal StartPoint EndPoint))
	        (equal MINAREA AREA 0.00001)
                (equal MAXAREA AREA 0.00001)
	    ) ;end or
	    (setq CNT (1+ CNT))
	    (ssdel ENT SS)
	) ;end if
) ;end repeat
(command "cmdecho" 1)
(if (> (sslength SS) 0)
	(progn
		(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
		(sssetfirst nil SS)
	) ;progn
	(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

 

The above code select only those Polygon whose "Start Point" and "End Point" both are same Or a "Closed Polygon"....


Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
0 Likes
Message 4 of 10

Kent1Cooper
Consultant
Consultant

@dbhunia wrote:

.... 

....
(if (or (and (<= MINLEN LEN) (>= MAXLEN LEN)) ....

 

A small thing, but the numerical comparison functions can take more than two arguments.  This much of the above:

 

(and (<= MINLEN LEN) (>= MAXLEN LEN))

 

can be just:

 

(<= MINLEN LEN MAXLEN)

 

and similarly with the area comparison in the other routine.

Kent Cooper, AIA
Message 5 of 10

Kent1Cooper
Consultant
Consultant

@dbhunia wrote:

....

 

....
(setq SS (ssget '((0 . "*LINE"))))) ;end if
....

 

Another thing you may not need to be concerned about, but just in case:

 

That will "see" SPLINE, MLINE and XLINE objects, any of which will cause errors, because none of them have a Length VLA property.  Better to use:

 

(ssget '((0 . "LINE,*POLYLINE")))

Kent Cooper, AIA
Message 6 of 10

Kent1Cooper
Consultant
Consultant

@vporrash141089 wrote:

....
(initget 1 "R F ")
(setq MODE
(getkword "Select lines within (R)ange or (F)ixed length : "))
(if (or (= MODE "") (= MODE "F"))
(setq MODE "F")
) ;end if
....


[My first Reply should also have been to Message 1, rather than Message 2.]  Another concern:

The MODE value can never be "" for that (if) test, because (getkword) does not return an empty string "" on Enter [the way (getstring) does], but rather returns nil.  So the "F" setting will never be invoked as a default, but only if the User types in  "F".  Besides, the 1 in the (initget) function forbids Enter anyway.  And if "F" is to be a default, it should be indicated in the prompt, so the User can see that they'll get it if they hit Enter.  I would go for:

(initget "R F"); no 1 -- allow  Enter
(setq MODE
  (cond

    ((getkword "\nSelect Lines within Range or of Fixed length [R/F] <F>: "))

    ("F"); if User hits Enter at above prompt, returning nil

  ); cond

); setq

 

If you ever use it more than once in an editing session, it could be made to remember your choice, and offer that as the default, rather than always offering "F".  And it could do the same with the fixed-length and range values, so you don't need to type them in again if you want to re-use the same values.  Write back if you want to know how to do that.

Kent Cooper, AIA
Message 7 of 10

dbhunia
Advisor
Advisor

Hi

 

@Kent1Cooper you are right ....... about this......

 


@Kent1Cooper wrote:

.........

 

 

That will "see" SPLINE, MLINE and XLINE objects, any of which will cause errors, because none of them have a Length VLA property.  Better to use:

 

(ssget '((0 . "LINE,*POLYLINE")))


 

@vporrash141089 here is the corrected code ......... use this........

 

(defun c:SSLineLen ( / *Error* cnt ent fixlen len stpt enpt maxlen minlen mode ss OPT)
(vl-load-com)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(initget 1 "L P B")
(setq OPT (getkword "\nWant to Select [Line/Polyline/Both]: "))

(initget 1 "R F ")
(setq MODE
(getkword "\nSelect lines within (R)ange or (F)ixed length : "))
;(if (or (= MODE "") (= MODE "F"))
;(setq MODE "F")
;) ;end if

(if (= MODE "F")
(setq FIXLEN (getdist "\nEnter fixed line length: "))
(progn
(setq MINLEN (getdist "\nEnter minimum length: "))
(setq MAXLEN (getdist "\nEnter maximum length: "))
) ;end progn else
) ;end if

(if (ssget "I")
    (progn
	(cond ((= OPT "L")
		(setq SS (ssget "I" '((0 . "LINE"))))
	      ) ;end cond L

	      ((= OPT "P")
		(setq SS (ssget "I" '((0 . "*POLYLINE"))))
	      ) ;end cond P
	      ((= OPT "B")
		(setq SS (ssget "I" '((0 . "LINE,*POLYLINE"))))
	      ) ;end cond B
	) ;end conditions
    )
    (progn
	(cond ((= OPT "L")
		(setq SS (ssget '((0 . "LINE"))))
	      ) ;end cond L

	      ((= OPT "P")
		(setq SS (ssget '((0 . "*POLYLINE"))))
	      ) ;end cond P
	      ((= OPT "B")
		(setq SS (ssget '((0 . "LINE,*POLYLINE"))))
	      ) ;end cond B
	) ;end conditions
    )
) ;end if
(setq CNT 0)
(repeat (sslength SS)

   	(setq ENT (ssname SS CNT)
      	   	;STPT (cdr (assoc 10 (entget ENT)))
		;ENPT (cdr (assoc 11 (entget ENT)))
		LEN (vla-get-length (vlax-ename->vla-object ENT))
   	) ;end setq

	(cond ((= MODE "F")
		(if (equal FIXLEN LEN 0.00001)
			(setq CNT (1+ CNT)) ;then next
			(ssdel ENT SS) ;else delete
		) ;end if
	      ) ;end cond F

	      ((= MODE "R")
		(if (or (and (<= MINLEN LEN) (>= MAXLEN LEN))
		        (equal MINLEN LEN 0.00001)
                        (equal MAXLEN LEN 0.00001)
		    ) ;end or
			(setq CNT (1+ CNT))
			(ssdel ENT SS)
		) ;end if
	      ) ;end cond R
	) ;end conditions
) ;end repeat

(if (> (sslength SS) 0)
(progn
(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
(sssetfirst nil SS)
) ;progn
(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
0 Likes
Message 8 of 10

hythamthelove
Advocate
Advocate

Hii everyone,

I like to say that the original code is brilliant, but i need it to do different thing.

I have lines with fixed lengths (300, 400, 600, 1000). I want the lisp to select these lines specifically, these settengs won't change. Can the lisp be modified to do that ?

0 Likes
Message 9 of 10

hythamthelove
Advocate
Advocate

Can it also delete the lines ?

0 Likes
Message 10 of 10

Kent1Cooper
Consultant
Consultant

@hythamthelove wrote:

....

I have lines with fixed lengths (300, 400, 600, 1000). I want the lisp to select these lines specifically,...


It won't be able to isolate those in selection, because the length is not a piece of information that is stored in what (ssget) can look for, but is only a result of where the endpoints are.  It would need to allow selection of Lines broadly, and then step through and check for the length of each, and keep those that fit your criteria.  Can you limit them in some other way(s), such as by their Layer?

 

But have you tried QSELECT?  With it, you can restrict what it finds by length.  You would need to do it separately for each length involved, but you can append the subsequent ones to what's already selected, for one collective selection set to do with what you want.

Kent Cooper, AIA
0 Likes