SELECT BY FRAME

[Anonymous]

Hello,

I wonder if somebody could help me with a lisp that make a selection of entities by frame , 

like the TRIM option. If we click on the trim option and choose frame, we can click the line that for the trimming , and then to click fence , and click over all the lines we want to trim.

I want the same but with delete option.

In this pic. I clicked on a line that I want the trim to be against it -"cutting line" , but I did it with trim command ,and the broblem is that it doesn't take the lines that starting from the "cutting line" , I want to make the selection from the cutting line with any object , and if I hit the deletion key it will erase only the lines or part of the lines that intersect with the cutting line. See the pic below.

http://imgur.com/a/0y6TZ

I hope I was clear enough,

Thank you

[ВeekeeCZ]

Not really sure what you want - do you ET's EXTRIM command?

[Anonymous]

Hi BeekeeCZ,

No , it is more like the trim and fence command.

The XTrim is to click on a line and then pick side to erase the lines on that side.

What I want is: to click on a line "cutting line" and then to click like you can see in the picture , every line that my lines are over it will be selected

http://imgur.com/a/0y6TZ

but because it is a trim and not delete option it didn't take the line that not intersecting with the cutting line.

I want exactly like the TRIM command but with every line that I am over it with my fence even if it doesn't intersect with the cutting line.

and after it selects those lines or part of a line ,I can decide if I delete them or move them , or something else.

Hope I am clear enough.

if not I will explain better.

Thank you

[ВeekeeCZ]

Ok then... try this one.

(vl-load-com)

(defun c:TrimDel ( / *error* cmd en pts ss)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if cmd (setvar 'CMDECHO cmd))
    (princ)
    )
  
  (setq cmd (getvar 'CMDECHO))
  (princ "\nCutting edge, ")
  
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,XLINE,XRAY,ELLOPSE"))))
    (progn
      (setvar 'CMDECHO 0)
      (princ "\nSpecify fence points: ")
      (command-s "_.PLINE")
      (setq en (entlast))
      (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))))
      (command "_.TRIM" ss "" "_Fence")
      (foreach pt pts (command pt))
      (command "" "")
      (command "_.ERASE" "_Fence")
      (foreach pt pts (command pt))
      (command "" en "")))
  (*error* "end")
  )

[ВeekeeCZ · Accepted solution]

One more -- trying to get a little better visual feedback. Not like the original command, but better (than nothing).

(vl-load-com)

(defun c:TrimDel ( / *error* pt pts ss px sx)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (princ))

  (defun HighlightObjects (ss switch / i)
    (repeat (setq i (sslength ss))
      (vlax-invoke-method (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'Highlight switch)))

; -------------------------------------------------------------------------------------------------
  
  (if (and (princ "\nSpecify cutting edge, ")
	   (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,XLINE,XRAY,ELLIPSE"))))
	   (setq pt (getpoint "\nSpecify first fence point: "))
	   (setq pts (cons pt pts))
	   (or (while (setq px (getpoint pt "\nSpecify next fence point: "))
		 (setq pts (cons px pts))
		 (if (setq sx (ssget "_F" (list pt px)))
		   (HighlightObjects sx :vlax-true))
		 (setq pt px))
	       (< 1 (length pts))
	       (progn "\nError. Two points as minimum."))
	   )
    (progn
      (command "_.TRIM" ss "" "_Fence")
      (foreach pt pts (command pt))
      (command "" ""
	       "_.ERASE" (ssget "_F" pts) "")))
  (*error* "end")
)

[marko_ribar]

Hi BekeeCZ... The code is good, but I think OP wants instead of TRIM, BREAK command and instead of ERASE, just grab those broken curves with (ssget "_F") and then grip and highlight them using (sssetfirst nil ss).

[Anonymous]

Hi BeeKeeCZ,

It works like a charm , 

But can you make another modification?

Instead of erasing those lines , the default will be to delete thoses lines , but I will have the option to hit a key like M - for move , and I can move thoses lines to a different location. It would be great and very usefull.

I don't quit sure what Marko suggested , but maybe it is a good idea too.

Thank you very much.

Eyal

[ВeekeeCZ]

I think Marco's suggestion has kind of point, even it's much more complicated. See the attachment what he means.

[Anonymous]

Hi,

If I understand correctly, I need the break and select , so I will have the option to choose if to delete it or move it,

I would be very glad if you can adjust the code so it will have the delete as default selection (if I hit ENTER),

and also have an option to hit M for move, this is very usefull lisp , and I don't know why autodesk don't accept it as build-in.

Also if it is not too much trouble to make , when I pick the frame like the TRIM command, to have the preview selection in color- red , looks better (for my opinion).

Thank you !

[marko_ribar]

BeekeeCZ, yes you are right that it is more complicated using BREAK especially if curves are closed like CIRCLES, or closed SPLINES, but you can try to do it with TRIM "FENCE" option and then remember trimmed parts on the other side of crossing line COPYBASE them with '(0 0 0), then do UNDO to state before trimming and then trim other side parts that were remembered. After that remember new trimmed parts from the side that are FENCED, do PASTECLIP with '(0 0 0) to implement missing parts from the other side and finally put remembered parts from FENCED side into new ss and grip and select that ss with (sssetfirst nil ss).

[ВeekeeCZ]

---

@marko_ribar wrote:

BeekeeCZ, yes you are right that it is more complicated using BREAK especially if curves are closed like CIRCLES, or closed SPLINES, but you can try to do it with TRIM "FENCE" option and then remember trimmed parts on the other side of crossing line COPYBASE them with '(0 0 0), then do UNDO to state before trimming and then trim other side parts that were remembered. After that remember new trimmed parts from the side that are FENCED, do PASTECLIP with '(0 0 0) to implement missing parts from the other side and finally put remembered parts from FENCED side into new ss and grip and select that ss with (sssetfirst nil ss).

---

Hmm, seems to me too much complicated.

I'll tend to use CAB's breaking function, especially BreakWith (modified to reversed selection than the original). Then add a fence re-selection should be easy enough.

@marko_ribar Not sure what complications you're talking about - would you try CAB's routine if it handles this potential issue good enough? 

@Anonymous also try this, if that works for you.

Then I could make those adjustments...

[marko_ribar]

BeekeeCZ, I know for BreakObjects and I've modified it further more to be correct and without gaps when CIRCLES, ELLIPSES, closed SPLINES and so on are reference entities, but it isn't quite stable especially if entities are big and far away from origin '(0 0 0) and it's too complex routine, so I didn't post it at theswamp... My version is 2.4. and for copyrighted issues I don't want to post it. Please reconsider process that I mentioned as I think it's more adequate for this task. To dive more deeply, when selected by fence, get intersection points with curves and crossing line. This way you'll be able to get other sided trimmed entities to COPYBASE them... Then obtain new point list for points on those entities from other side for doing another trim after UNDO-ing to state before trimming... Everything else is like I described.

[Anonymous]

Hi BeeKeeCZ,

I just want to make sure you understand me correctly.

http://imgur.com/a/2G3z7

Here is the result of your lisp TRIMDEL , it works perfect for me , I just want to know if the lines that had been deleted can be moved instead of being deleted.

[ВeekeeCZ]

Ok guys, I do understand the issue. Frankly not big fan of Marco's suggestion. I'll think about it... look into it later.

@Anonymous post some small part of real drawing - dwg! And AGAIN, test the suggested Breaking routine on some real data if that could be a way to go (apart of that selection thing which could be added)

Thanks Marco for your feedback about that Breaking routine. I am using it sometimes, seems to me good enough. (not expecting miracles)

[Anonymous]

Hi BeeKeeCZ,

here is an example for my use with your lisp TRIMDEL , 

https://www.dropbox.com/s/ok0i3enkctobod7/trimdel.dwg?dl=0

I have also some drawings that I should take the trimmed parts by move or copy ( I can't find an example right now)

Here is onother thing that I want to use "frame select", maybe it's belong to another post,

If I want to select all the columns names (C1,C2,etc) I can use the crossing lasso , but a frame select is much easier, 

Can you make please a frame select so I can select the items that I want with getting over them with a continus line?

https://www.dropbox.com/s/0in73xg0yy7bzp8/move.dwg?dl=0

Thank you , 

You are very helpfull.

[Anonymous]

Hi BeeKeeCZ,

here is an example for my use with your lisp TRIMDEL , 

@https://www.dropbox.com/s/ok0i3enkctobod7/trimdel.dwg?dl=0

I have also some drawings that I should take the trimmed parts by move or copy ( I can't find an example right now)

Here is onother thing that I want to use "frame select", maybe it's belong to another post,

If I want to select all the columns names (C1,C2,etc) I can use the crossing lasso , but a frame select is much easier, 

Can you make please a frame select so I can select the items that I want with getting over them with a continus line?

@https://www.dropbox.com/s/0in73xg0yy7bzp8/move.dwg?dl=0

Thank you , 

You are very helpfull.

[marko_ribar]

@Anonymous

Here, I've cobbled something meanwhile, based on my description I posted... You can test it and if something's wrong, reply...

(defun c:sscrossfence ( / *error* triplet curve2plst adoc u s c p f i e q l z )

  (vl-load-com)

  (defun *error* ( m )
    (if u
      (command "_.UCS" "_P")
    )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun triplet ( l / p a )
    (repeat (/ (length l) 3)
      (setq p (list (car l) (cadr l) (caddr l)))
      (setq a (cons p a))
      (setq l (cdddr l))
    )
    (reverse a)
  )

  (defun curve2plst ( c / s e d l k p )
    (setq s (vlax-curve-getstartpoint c) e (vlax-curve-getendpoint c))
    (setq d (/ (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 100))
    (setq l (cons s l) k 0)
    (repeat 99
      (setq p (vlax-curve-getpointatdist c (* (setq k (1+ k)) d)))
      (setq l (cons p l))
    )
    (setq l (cons e l))
    (reverse l)
  )

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq u t)
    )
  )
  (prompt "\nPick crossing curve...")
  (setq s (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XLINE"))))
  (while (not s)
    (prompt "\nMissed... Pick crossing curve again...")
    (setq s (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XLINE"))))
  )
  (setq c (ssname s 0))
  (redraw c 3)
  (prompt "\nPick points for FENCE selection...")
  (while (if (null p) (setq p (getpoint)) (progn (initget 32) (setq p (getpoint p))))
    (setq f (cons p f))
    (if (cadr f)
      (mapcar (function (lambda ( a b ) (grdraw a b 253 1))) f (cdr f))
    )
  )
  (setq s (ssget "_F" f))
  (while (not s)
    (prompt "\nEmpty fence selection... Please retry fence selection so that sel.set contains at least 1 2d curve entity...")
    (while (if (null p) (setq p (getpoint)) (progn (initget 32) (setq p (getpoint p))))
      (setq f (cons p f))
      (if (cadr f)
        (mapcar (function (lambda ( a b ) (grdraw a b 253 1))) f (cdr f))
      )
    )
    (setq s (ssget "_F" f))
  )
  (repeat (setq i (sslength s))
    (setq e (ssname s (setq i (1- i))))
    (setq q (triplet (vlax-invoke (vlax-ename->vla-object c) 'intersectwith (vlax-ename->vla-object e) acextendnone)))
    (setq l (append q l))
  )
  (command "_.TRIM" c "" "_F")
  (foreach p f
    (command "_non" p)
  )
  (while (< 0 (getvar 'cmdactive)) (command ""))
  (setq s (ssadd))
  (foreach p l
    (setq e (ssname (ssdel c (ssget "_C" p p)) 0))
    (if (not (ssmemb e s))
      (ssadd e s)
    )
  )
  (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    (setq p (curve2plst e))
    (setq z (cons p z))
  )
  (command "_.COPYBASE" "_non" '(0 0 0) s "")
  (command "_.UNDO" "_B")
  (foreach x z
    (if (< (distance (cadr x) (vlax-curve-getclosestpointto c (cadr x))) (distance (nth (- (length x) 2) x) (vlax-curve-getclosestpointto c (nth (- (length x) 2) x))))
      (progn
        (command "_.TRIM" c "" "_non" (cadr x))
        (while (< 0 (getvar 'cmdactive)) (command ""))
      )
      (progn
        (command "_.TRIM" c "" "_non" (nth (- (length x) 2) x))
        (while (< 0 (getvar 'cmdactive)) (command ""))
      )
    )
    (foreach p (cddr (reverse (cddr (reverse x))))
      (if (setq s (ssget "_C" p p))
        (entdel (ssname s 0))
      )
    )
  )
  (setq s (ssadd))
  (foreach p l
    (setq e (ssname (ssdel c (ssget "_C" p p)) 0))
    (if (not (ssmemb e s))
      (ssadd e s)
    )
  )
  (command "_.PASTECLIP" "_non" '(0 0 0))
  (sssetfirst nil s)
  (*error* nil)
)

Regards, M.R.

[Anonymous]

Hi Marko,

I have tried your lisp , and:

1. It erases some of the lines and not break them . It suppose to break the lines that I pick with the fence lines and letting the option to move them.

2. It erases the cutting line.

Thank you, 

but I would be very appreciate for a simple code that let me do fence line selection so I can select intead of the lasso selection.

https://www.dropbox.com/s/s1yn4a4f069d0xj/2017-04-19_19-39-36.jpg?dl=0

Just a selection.

for the cutting line , I will use BeeKeeCZ lisp , that is very close to what I wanted.

Thank you!!

[marko_ribar]

I've found some lacks in my code... Please, retest it now...

(defun c:sscrossfence ( / *error* triplet curve2plst adoc u s c p f i e q l z )

  (vl-load-com)

  (defun *error* ( m )
    (if u
      (command "_.UCS" "_P")
    )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun triplet ( l / p a )
    (repeat (/ (length l) 3)
      (setq p (list (car l) (cadr l) (caddr l)))
      (setq a (cons p a))
      (setq l (cdddr l))
    )
    (reverse a)
  )

  (defun curve2plst ( c / s e d l k p )
    (setq s (vlax-curve-getstartpoint c) e (vlax-curve-getendpoint c))
    (setq d (/ (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 10))
    (setq l (cons s l) k 0)
    (repeat 9
      (setq p (vlax-curve-getpointatdist c (* (setq k (1+ k)) d)))
      (setq l (cons p l))
    )
    (setq l (cons e l))
    (reverse l)
  )

  (if (= (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq u t)
    )
  )
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (prompt "\nPick crossing curve...")
  (setq s (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XLINE"))))
  (while (not s)
    (prompt "\nMissed... Pick crossing curve again...")
    (setq s (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XLINE"))))
  )
  (setq c (ssname s 0))
  (redraw c 3)
  (prompt "\nPick points for FENCE selection...")
  (while (if (null p) (setq p (getpoint)) (progn (initget 32) (setq p (getpoint p))))
    (setq f (cons p f))
    (if (cadr f)
      (mapcar (function (lambda ( a b ) (grdraw a b 253 1))) f (cdr f))
    )
  )
  (setq s (ssget "_F" f))
  (while (not s)
    (prompt "\nEmpty fence selection... Please retry fence selection so that sel.set contains at least 1 2d curve entity...")
    (while (if (null p) (setq p (getpoint)) (progn (initget 32) (setq p (getpoint p))))
      (setq f (cons p f))
      (if (cadr f)
        (mapcar (function (lambda ( a b ) (grdraw a b 253 1))) f (cdr f))
      )
    )
    (setq s (ssget "_F" f))
  )
  (repeat (setq i (sslength s))
    (setq e (ssname s (setq i (1- i))))
    (setq q (triplet (vlax-invoke (vlax-ename->vla-object c) 'intersectwith (vlax-ename->vla-object e) acextendnone)))
    (setq l (append q l))
  )
  (command "_.TRIM" c "" "_F")
  (foreach p f
    (command "_non" p)
  )
  (while (< 0 (getvar 'cmdactive)) (command ""))
  (setq s (ssadd))
  (foreach p l
    (setq e (ssname (ssdel c (ssget "_C" p p)) 0))
    (if (not (ssmemb e s))
      (ssadd e s)
    )
  )
  (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    (setq p (curve2plst e))
    (setq z (cons p z))
  )
  (command "_.COPYBASE" "_non" '(0 0 0) s "")
  (command "_.UNDO" "_B")
  (foreach x z
    (if (< (distance (cadr x) (vlax-curve-getclosestpointto c (cadr x))) (distance (nth (- (length x) 2) x) (vlax-curve-getclosestpointto c (nth (- (length x) 2) x))))
      (progn
        (command "_.TRIM" c "" "_non" (cadr x))
        (while (< 0 (getvar 'cmdactive)) (command ""))
      )
      (progn
        (command "_.TRIM" c "" "_non" (nth (- (length x) 2) x))
        (while (< 0 (getvar 'cmdactive)) (command ""))
      )
    )
    (foreach p (cddr (reverse (cddr (reverse x))))
      (if (setq s (ssget "_C" p p))
        (entdel (ssname s 0))
      )
    )
  )
  (setq s (ssadd))
  (foreach p l
    (setq e (ssname (ssdel c (ssget "_C" p p)) 0))
    (if (not (ssmemb e s))
      (ssadd e s)
    )
  )
  (command "_.PASTECLIP" "_non" '(0 0 0))
  (*error* nil)
  (sssetfirst nil s)
  (princ)
)

Regards, M.R.

[Anonymous]

Hi Marko,

Sorry but it seems to be different from what I wanted, maybe I didn't clear myself :

I wanted exactly what BeeKeeCZ did : 

(vl-load-com)

(defun c:TrimDel ( / *error* pt pts ss px sx)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (princ))

  (defun HighlightObjects (ss switch / i)
    (repeat (setq i (sslength ss))
      (vlax-invoke-method (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'Highlight switch)))

; -------------------------------------------------------------------------------------------------
  
  (if (and (princ "\nSpecify cutting edge, ")
	   (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,XLINE,XRAY,ELLIPSE"))))
	   (setq pt (getpoint "\nSpecify first fence point: "))
	   (setq pts (cons pt pts))
	   (or (while (setq px (getpoint pt "\nSpecify next fence point: "))
		 (setq pts (cons px pts))
		 (if (setq sx (ssget "_F" (list pt px)))
		   (HighlightObjects sx :vlax-true))
		 (setq pt px))
	       (< 1 (length pts))
	       (progn "\nError. Two points as minimum."))
	   )
    (progn
      (command "_.TRIM" ss "" "_Fence")
      (foreach pt pts (command pt))
      (command "" ""
	       "_.ERASE" (ssget "_F" pts) "")))
  (*error* "end")
)

BUT with small modification,

Instead of having the lines that broke lines and the other entities that I fence with the fence line deleted, to have them selected only so I can move them or copy them or delete them later.

like in the picture:

https://www.dropbox.com/s/blt2068vsfrybwj/2017-04-19_20-20-51.jpg?dl=0

I hope I clear now , and sorry for inconvenience.

Thank you.