Trim inside selected rectangles

[Abrasive]

I remember having a routine that allowed me to select multiple rectangles at once and trim/delete everything inside of those rectangles....

I can't seem to find it anywhere now?

found a couple that have you select corner to corner but I need to select multiple rectangles at a time.

Not power trim or xtrim either, it was a lisp routine.

Maybe someone can point me in the right direction?

Thanks In Advance!

[mhupp]

Do the rectangles overlap?

[Abrasive]

19 minutes ago, mhupp said:

Do the rectangles overlap?

No, none of the rectangles overlap.

 

[devitg]

Did you try EXTRIM ? from express tools

[mhupp]

This uses Cab's lisp BreakObjects23.LSP The swamp requires you to have a login to access the files but you can google it and find it on other websites.

 

Example in use   

 

-Edit

It also defaults to inside.

 

-Edit2

Forgot the clockwise checker function

Type: TrimWithPoly or TWP to run

 

-Edit 3

always forgeting the (vl-load-com)

         

;;======================================================
;;  Trim Selected Objects With Selected Polylines  
;;======================================================
(defun C:TWP () (C:TrimWithPoly)
(defun C:TrimWithPoly (/ Drawing SS1 SS2 SSB SSA LastEnt coords rep)
  (vl-load-com)
  (vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object))))
  (setvar "CMDECHO" 0)
  (setq LastEnt (entlast))
  (prompt "\nSelect Object(s) to Trim: ")
  (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
           (not (ssredraw ss1 3))
           (not (prompt "\nSelect Object(s) to Trim With: "))
           (setq ss2 (ssget '((0 . "*POLYLINE"))))
           (not (ssredraw ss1 4))
      )
    (break_with ss1 ss2 nil 0)  ; ss1break ss2breakwith (flag nil = not to break with self)
  )
  (setq SSA (ssadd))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS2)))
    (vla-offset (vlax-ename->vla-object ent) (if (CW ent) -0.01 0.01))
    (setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
    (setq SSB (ssget "_WP" coords))
    (setq SSA (acet-ss-union (list SSA SSB)))
  )
  (while (setq LastEnt (entnext LastEnt))
    (ssadd LastEnt SS1)
  )
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSA)))
    (ssdel ent SS1)
  )
  (initget "Inside Outside")
  (setq rep
    (cond
      ((getkword "\nTrim <Inside> or Outside: ")) ("Inside")
    )
  )
  (if (= rep "Inside")
    (command "_.Delete" SSA "")
    (command "_.Delete" SS1 "")
  )
  (vla-endundomark Drawing)
  (princ)
)
;;----------------------------------------------------------------------------;;
; Checking if pline drawn CW or CCW - Writer Evgeniy Elpanov By Bill Gilliss
(defun CW (poly / lw lst LL UR)
  (setq lw (vlax-ename->vla-object poly))
  (vla-GetBoundingBox lw 'LL 'UR)
  (setq LL (vlax-safearray->list LL)
        UR (vlax-safearray->list UR)
        lst (mapcar
              (function
                (lambda (x)
                        (vlax-curve-getParamAtPoint poly
                                                    (vlax-curve-getClosestPointTo poly x)
                        )
                )
              )
              (list LL (list (car LL) (cadr UR))
                    UR (list (car UR) (cadr LL))
              )
            )
  )
  (if
    (or
      (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
      (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
      (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
      (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    ) ;_ or
    t
  )
)

Edited December 21, 2022 by mhupp
Code Updated

[Abrasive]

getting an error:

"Error: Library not registered.."

If I comment out this line:

(vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object))))

The error goes away but doesn't give me the option to "Select Object(s) to Trim With:"

 

Not sure how if it makes a difference but I'm using DRAFTISGHT.

 

Edited December 21, 2022 by Abrasive

[mhupp]

sorry, always forgeting the (vl-load-com). you need that to load most vla- vlax- or vl-  commands. code upated above.

Edited December 21, 2022 by mhupp

[BIGAL]

You can run extrim with no user input the answer is to use (etrim ent pt) so as you have rectangs the pt is the mid of 1st and 3rd vertice.

 

;Entity-TRIM function
;takes: na - entity name
;  a - a point, the side to trim on
;NOTE: This function does not allow for the possible miss of
;      non-continuous linetypes.
;
(defun etrim ( na a / 

 

2nd step is to erase all objects inside rectang.

 

(defun c:whatuwnattocallit ( / ss x ent co-ord mp)
(if (not etrim)(load "extrim"))
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (1- x))))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (cons (last co-ord) co-ord))
(setq mp (mapcar '* (mapcar '+ (nth 0 co-ord)(nth 2 co-ord)) '(0.5 0.5)))
(etrim ent mp)
(command "erase" (ssget "WP" co-ord ) "")
)
(princ)
)
(c:whatuwnattocallit)

 

Edited December 21, 2022 by BIGAL

[Abrasive]

12 minutes ago, mhupp said:

sorry, always forgeting the (vl-load-com). you need that to load most vla- vlax- or vl-  commands. code upated above.

still getting the error?

I also tried (vla-load) and (vl-load-com)

[Abrasive]

11 minutes ago, BIGAL said:

You can run extrim with no user input the answer is to use (etrim ent pt) so as you have rectangs the pt is the mid of 1st and 3rd vertice.

 

;Entity-TRIM function
;takes: na - entity name
;  a - a point, the side to trim on
;NOTE: This function does not allow for the possible miss of
;      non-continuous linetypes.
;
(defun etrim ( na a / 

 

I don't have that function available.....

[mhupp]

either remove the start ans end marks completely

or replace them with

(command "_.Undo" "_Begin")
(command "_.Undo" "_End")

 

[BIGAL]

Have a look at what I posted above at same time as other posts.

[mhupp]

@BIGAL wp coords wont select things touching the poly thats why i had to offset.

[BIGAL]

Yes could be a problem pretty easy to add also an offset and a SSGET "F" to get touching objects also do erase twice. I think without sample dwg don't know if needed.

 

For Abrasive you need the express tools to be loaded. But here is extrim any way.

extrim.lsp

[Abrasive]

@BIGAL I'm using Draftsight....express tools is not available to me.

 

@mhupp

Feeling kind of dumb, I can't get it working

[mhupp]

No worries friend you also need to load Cab's lisp for mine to work. if your getting an error about "break_with" not being a function

 

;;======================================================
;;  Trim Selected Objects With Selected Polylines  
;;======================================================
(defun C:TWP () (C:TrimWithPoly)
(defun C:TrimWithPoly (/ Drawing SS1 SS2 SSB SSA LastEnt coords rep)
  (command "_.Undo" "_Begin")
  (setvar 'cmdecho 0)
  (setq LastEnt (entlast))
  (prompt "\nSelect Object(s) to Trim: ")
  (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
           (not (ssredraw ss1 3))
           (not (prompt "\nSelect Object(s) to Trim With: "))
           (setq ss2 (ssget '((0 . "*POLYLINE"))))
           (not (ssredraw ss1 4))
      )
    (break_with ss1 ss2 nil 0)  ; ss1break ss2breakwith (flag nil = not to break with self)
  )
  (setq SSA (ssadd))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS2)))
    (vla-offset (vlax-ename->vla-object ent) (if (CW ent) -0.01 0.01))
    (setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
    (setq SSB (ssget "_WP" coords))
    (setq SSA (acet-ss-union (list SSA SSB)))
  )
  (while (setq LastEnt (entnext LastEnt))
    (ssadd LastEnt SS1)
  )
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSA)))
    (ssdel ent SS1)
  )
  (initget "Inside Outside")
  (setq rep
    (cond
      ((getkword "\nTrim <Inside> or Outside: ")) ("Inside")
    )
  )
  (if (= rep "Inside")
    (command "_.Delete" SSA "")
    (command "_.Delete" SS1 "")
  )
  (command "_.Undo" "_End") 
  (setvar 'cmdecho 1)
  (princ)
)
;;----------------------------------------------------------------------------;;
; Checking if pline drawn CW or CCW - Writer Evgeniy Elpanov By Bill Gilliss
(defun CW (poly / lw lst LL UR)
  (setq lw (vlax-ename->vla-object poly))
  (vla-GetBoundingBox lw 'LL 'UR)
  (setq LL (vlax-safearray->list LL)
        UR (vlax-safearray->list UR)
        lst (mapcar
              (function
                (lambda (x)
                        (vlax-curve-getParamAtPoint poly
                                                    (vlax-curve-getClosestPointTo poly x)
                        )
                )
              )
              (list LL (list (car LL) (cadr UR))
                    UR (list (car UR) (cadr LL))
              )
            )
  )
  (if
    (or
      (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
      (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
      (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
      (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    ) ;_ or
    t
  )
)

 

Edited December 22, 2022 by mhupp

[BIGAL]

Try loading the extrim.lsp I posted does it work in Drafsight /

[tombu]

9 hours ago, BIGAL said:

Try loading the extrim.lsp I posted does it work in Drafsight /

The extrim.lsp you attached is loaded with (AutoCAD Express Tool) acet-* functions. Wouldn't AutoCAD's Express Tools have to be loaded for them to work?

[Abrasive]

12 hours ago, mhupp said:

No worries friend you also need to load Cab's lisp for mine to work. if your getting an error about "break_with" not being a function

 

;;======================================================
;;  Trim Selected Objects With Selected Polylines  
;;======================================================
(defun C:TWP () (C:TrimWithPoly)
(defun C:TrimWithPoly (/ Drawing SS1 SS2 SSB SSA LastEnt coords rep)
  (command "_.Undo" "_Begin")
  (setvar 'cmdecho 0)
  (setq LastEnt (entlast))
  (prompt "\nSelect Object(s) to Trim: ")
  (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
           (not (ssredraw ss1 3))
           (not (prompt "\nSelect Object(s) to Trim With: "))
           (setq ss2 (ssget '((0 . "*POLYLINE"))))
           (not (ssredraw ss1 4))
      )
    (break_with ss1 ss2 nil 0)  ; ss1break ss2breakwith (flag nil = not to break with self)
  )
  (setq SSA (ssadd))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS2)))
    (vla-offset (vlax-ename->vla-object ent) (if (CW ent) -0.01 0.01))
    (setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
    (setq SSB (ssget "_WP" coords))
    (setq SSA (acet-ss-union (list SSA SSB)))
  )
  (while (setq LastEnt (entnext LastEnt))
    (ssadd LastEnt SS1)
  )
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSA)))
    (ssdel ent SS1)
  )
  (initget "Inside Outside")
  (setq rep
    (cond
      ((getkword "\nTrim <Inside> or Outside: ")) ("Inside")
    )
  )
  (if (= rep "Inside")
    (command "_.Delete" SSA "")
    (command "_.Delete" SS1 "")
  )
  (command "_.Undo" "_End") 
  (setvar 'cmdecho 1)
  (princ)
)
;;----------------------------------------------------------------------------;;
; Checking if pline drawn CW or CCW - Writer Evgeniy Elpanov By Bill Gilliss
(defun CW (poly / lw lst LL UR)
  (setq lw (vlax-ename->vla-object poly))
  (vla-GetBoundingBox lw 'LL 'UR)
  (setq LL (vlax-safearray->list LL)
        UR (vlax-safearray->list UR)
        lst (mapcar
              (function
                (lambda (x)
                        (vlax-curve-getParamAtPoint poly
                                                    (vlax-curve-getClosestPointTo poly x)
                        )
                )
              )
              (list LL (list (car LL) (cadr UR))
                    UR (list (car UR) (cadr LL))
              )
            )
  )
  (if
    (or
      (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
      (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
      (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
      (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    ) ;_ or
    t
  )
)

 

 

Calculating Break Points, Please Wait.

"(null):  (null)""(null):  (null)""(null):  (null)"

 Error: Invalid parameter.

 

Loaded CAB's routine and tried. 

I was able to to select objects to trim and objects to trim with but them the above error shows?

 

 

[mhupp]

Draftsight says it can use visual lisp Give this a test on two objects that are overlapping. should look something like this.

 

: test
Select Object
#<VLA-OBJECT IAcadCircle 0000000034136D70>
Select Object
#<VLA-OBJECT IAcadLWPolyline 0000000034138670>
(38.4875958273987 6.35534521426045 0.0 59.4778766221801 -15.5266360848402 0.0)

 

(defun C:test (/ obj1 obj2 pts-lst)
  (vl-load-com)
  (setq obj1 (vlax-ename->vla-object (car (entsel "\nSelect Object"))))
  (princ "\n")
  (princ obj1)
  (setq obj2 (vlax-ename->vla-object (car (entsel "\nSelect Object"))))
  (princ "\n")
  (princ obj2)
  (setq pts-lst (vlax-safearray->list (vlax-variant-value (vla-intersectwith obj1 obj2 acextendnone))))
  (princ "\n")
  (princ pts-lst)
  (princ)
)