Extrim Multiple

[benhubel]

I love Extrim, but it only does one trim at a time. I am looking to trim everything that is selected at once.

 

The pseudocode goes like this:

1. Get selection

2. Filter out everything but closed polylines

3. Ask user if they want to just trim crossing lines, or to delete everything 4. selected on that side of the line.

5. Get a point as the side to extrim on. If inside any selected polyline, get the inside point of each polyline and then trim inside each one (or inside the boundary of any crossing ones). Likewise, if outside of all selected polylines, trim the outside of each one (or outside the boundary of any crossing ones).

 

My main problem is that I have no clue what I'm doing when it comes to dealing with Extrim. The syntax keeps throwing me around. I thought it would be super simple when I started, but because Extrim is a LISP rather than a command, it's got me really confused.

 

I was planning to make use of alanjt's SelectWithinCurve routine to help with deleting non-crossing geometry.

[marko_ribar]

Check this old post :

http://www.cadtutor.net/forum/showthread.php?68144-how-trim-many-line-inside-multi-circle-on-one-step/page2&p=#19

 

M.R.

[benhubel]

Thank you! I thought that I had looked through everything, but apparently not. This saves me a bunch of time.

I'll see if I can get my extra features plugged into this.

[benhubel]

After looking through that code, I have modified it a bit.

 

I still have to find a way to:

1. detect all crossing cutting edges

2. write a region around each set of intersecting edges

3. learn how to get newly created entities so that I can actually use the new regions to cut with

4. cleverly implement the SelectWithinCurve code to delete the objects that the hands of Trim are too short to catch

 

Because I have no idea what I'm doing, I would gladly accept any help that anybody wants to give. This reply is mostly just a status update, though, for those who are curious. I think I have the necessary knowledge to trudge through this mud.

 

;Extrim Multiple
;Original code posted by marko_ribar to http://www.cadtutor.net/forum/showthread.php?68144-how-trim-many-line-inside-multi-circle-on-one-step/page2&p=#19
;Edited by benhubel to suit his frivolous desires
;Please forgive the code hacks, I don't actually know what I'm doing.

(defun c:et () ;normal extrim shortcut for quick access
(c:extrim)
) ;end et

(defun c:eti () ;shortcut to extrim on the inside of all selected and closed polylines
(setq etside 1)
(c:etm)
) ;end eti

(defun c:eto () ;shortcut to extrim on the outside of all selected and closed polylines
(setq etside 2)
(c:etm)
) ;end eto

(defun c:etm ( / rnd GroupByNum ptonline ptinsideent highlight 
                    ss n en ed enA minpt maxpt dx dy pt dxx dyy ) ;extrim multiple
                    
 (vl-load-com)

 (load "extrim.lsp")

 (defun rnd (/ modulus multiplier increment rand)
   (if (not seed)
     (setq seed (getvar "DATE"))
   )
   (setq modulus    65536
         multiplier 25173
         increment  13849
         seed  (rem (+ (* multiplier seed) increment) modulus)
         rand     (/ seed modulus)
   )
 )

 (defun GroupByNum ( l n / f )
   (defun f ( a b )
     (if (and a (< 0 b))
       (cons (car a) (f (setq l (cdr a)) (1- b)))
     )
   )
   (if l (cons (f l n) (GroupByNum l n)))
 )

 (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
   (setq vec12 (mapcar '- pt2 pt1))
   (setq vec12 (reverse (cdr (reverse vec12))))
   (setq vec1p (mapcar '- pt pt1))
   (setq vec1p (reverse (cdr (reverse vec1p))))
   (setq vec2p (mapcar '- pt2 pt))
   (setq vec2p (reverse (cdr (reverse vec2p))))
   (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
   (if (equal d (+ d1 d2) 1e- (setq result T) (setq result nil))
   result
 )

 (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
   (vl-load-com)
   (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
   (setq ptt (vlax-curve-getclosestpointto ent pt))
   (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
   (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
   (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
   (setq k 0)
   (while (< (setq k (1+ k)) (length int))
     (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
   )
   (setq tst (reverse tst))
   (setq k 0)
   (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
   (vla-delete xlin)
   (if kk
     (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
     (setq result nil)
   )
   result
 )

 (setq highlight (getvar "HighLight"))
 (acet-error-init (list
                    (list   "cmdecho" 0
                          "highlight" highlight
                          "regenmode" 1
                             "osmode" 0
                            "ucsicon" 0
                         "offsetdist" 0
                             "attreq" 0
                           "plinewid" 0
                          "plinetype" 1
                           "gridmode" 0
                            "celtype" "CONTINUOUS"
                          "ucsfollow" 0
                           "limcheck" 0
                    )
                    T     ;flag. True means use undo for error clean up.
                    '(if redraw_it (redraw na 4))
                   );list
 );acet-error-init

 (prompt "\nSelect closed entities: ")
 (if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(-4 . "<not") '(-4 . "&=") '(70 .  '(-4 . "not>") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
   (progn
     (setq n (sslength ss))
     (while (>= (setq n (1- n)) 0)
       (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
         (vla-getboundingbox enA 'minpoint 'maxpoint)
       (setq
        minpt (vlax-safearray->list minpoint)
        maxpt (vlax-safearray->list maxpoint)
       )
       (setq dx (- (car maxpt) (car minpt)))
       (setq dy (- (cadr maxpt) (cadr minpt)))
       (setq pt '(0.0 0.0 0.0)) ;I think this was originally put here to initialize pt. I don't actually see why it's needed.
	(if(= etside nil)(setq etside (getint "\nDo you want to trim inside or outside? (1)Inside or (2)Outside: ")));Ask if this is an inside job or if we need our forces outside the curves.
	(if(= etside 2) ;If the variable etside has been set to (2)Outside
		(setq pt '(9999999.0 9999999.0 9999999.0));get a point in the middle of nowhere. The unlucky ******* who puts his geometry around this point will have problems. Poor guy.
		;else  -  setting the etside int to (1)Inside is a placebo, it could've been set to 93. We probably need some error handling of some sort here
		(while (not (ptinsideent pt en));get a point inside the polyline. marko_ribar did far better with this part than I know how to do.
			 (setq dxx (* dx (rnd)))
			 (setq dyy (* dy (rnd)))
			 (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
		)
	);end if
       (etrim en pt)
     )
   )
 )
 (setq etside nil) ;reset etside to nil just to make sure an error doesn't slip through on second run. I'm not sure if it actually helps or not.
 (acet-error-restore)
 (princ)
)

 

**Edit**

Apparently I forgot to trim down my comments. At least now I know that cadtutor doesn't appreciate the more colorful side of the English language.

Edited May 4, 2016 by benhubel
Amused note

[BIGAL]

Removed post read code again uses (etrim obj pt1)

[KARDOLITO89]

Command: ETI
Error: no function definition: C:ETMAutoCAD variable setting rejected: "osmode" nil

 

 

PLEASE 

[KARDOLITO89]

Error: extra cdrs in dotted pair on inputAutoCAD variable setting rejected: "osmode" nil