Jump to content

Trim Lines inside Rectangs

Mountain_XD

By Mountain_XD
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

SLW210 Grand Master

SLW210

Posted
Posted

Sorry it took me a while to clean this up, it worked on your sample drawing.

 

I was trying to get it to do any closed shape, but couldn't get Ellipses and Pline Ellipses to work. I'll get back to that when time allows.

  

;;; Trim (Lines & LWPolylines) Inside Closed Shapes (LWPolylines & Circles) = TICS                 |
;;;                                                                                                | 
;;; https://www.cadtutor.net/forum/topic/98452-trim-lines-inside-rectangs/#findComment-674554      | 
;;;                                                                                                | 
;;; By SLW210 (a.k.a. Steve Wilson)                                                                |
;;;                                                                                                | 
;;; TICS.lsp                                                                                       | 
;;;                                                                                                |
;;; (Needs improvement, need to add Ellipses and Pline Ellipses to Shapes to trim with.)           |
;;;                                                                                                | 
;;;================================================================================================|


(defun evenp (n) (= (rem n 2) 0))

(defun ent-in-ss (ent ss / i found)
  (setq	found nil
	i 0
  )
  (while (and (< i (sslength ss)) (not found))
    (if	(equal ent (ssname ss i))
      (setq found T)
      (setq i (1+ i))
    )
  )
  found
)

;; Ray casting algorithm for closed LWPolyline.
(defun point-inside-polygon (pt plObj / crossings i paramCount p1 p2)
  (setq crossings 0)
  (setq pCount (fix (vlax-curve-getEndParam plObj)))
  (setq i 0)
  (while (< i pCount)
    (setq p1 (vlax-curve-getPointAtParam plObj i))
    (setq p2 (vlax-curve-getPointAtParam plObj (1+ i)))
    (if	(and (> (cadr pt) (min (cadr p1) (cadr p2)))
	     (<= (cadr pt) (max (cadr p1) (cadr p2)))
	     (<	(car pt)
		(+ (car p1)
		   (* (- (cadr pt) (cadr p1))
		      (/ (- (car p2) (car p1)) (- (cadr p2) (cadr p1)))
		   )
		)
	     )
	)
      (setq crossings (1+ crossings))
    )
    (setq i (1+ i))
  )
  (not (evenp crossings))
)

;;;================================================================================================|
(defun c:TICS (/	 ssShapes
	       ssLines	 i
	       j	 ent
	       entObj	 shapeEnt
	       shapeObj	 shapeType
	       pts	 allIntPts
	       p1	 p2
	       mid	 inside?
	       origColor
	      )
  (vl-load-com)
  (prompt
    "\n--- Trim Lines & LWPolylines Inside Circles & Closed LWPoplylines ---\n"
  )
  ;; Prompt to select shapes for trimming
  (prompt "\nSelect closed polylines or circles as trimming boundaries:"
  )
  (setq ssShapes (ssget '((0 . "LWPOLYLINE,CIRCLE"))))
  (if (not ssShapes)
    (progn (prompt "\nNo valid trimming shapes selected.") (exit))
  )
  ;; Select all lines and polylines in drawing
  (setq ssLines (ssget "X" '((0 . "LINE,LWPOLYLINE"))))
  (if (not ssLines)
    (progn (prompt "\nNo lines or polylines found to trim.") (exit))
  )
  (setq i 0)
  (while (< i (sslength ssLines))
    (setq ent (ssname ssLines i))
    (if	(not (ent-in-ss ent ssShapes))
      (progn
	(setq entObj (vlax-ename->vla-object ent))
	(setq origColor (vla-get-Color entObj))
	;; Collect intersection points with all shapes
	(setq allIntPts '())
	(setq j 0)
	(while (< j (sslength ssShapes))
	  (setq shapeEnt (ssname ssShapes j))
	  (setq shapeObj (vlax-ename->vla-object shapeEnt))
	  (setq shapeType (cdr (assoc 0 (entget shapeEnt))))
	  (if (or (= shapeType "LWPOLYLINE") (= shapeType "CIRCLE"))
	    (progn (setq pts (vlax-invoke
			       shapeObj
			       'IntersectWith
			       entObj
			       acExtendNone
			     )
		   )
		   (if (and pts (> (length pts) 2))
		     (progn (repeat (/ (length pts) 3)
			      (setq allIntPts (append allIntPts
						      (list (list (car pts)
								  (cadr pts)
								  (caddr pts)
							    )
						      )
					      )
			      )
			      (setq pts (cdddr pts))
			    )
		     )
		   )
	    )
	  )
	  (setq j (1+ j))
	)
	(if (null allIntPts)
	  (progn (setq mid
			(cond ((= (vla-get-objectname entObj) "AcDbLine")
			       (mapcar '(lambda (a b) (/ (+ a b) 2.0))
				       (vlax-get entObj 'StartPoint)
				       (vlax-get entObj 'EndPoint)
			       )
			      )
			      ((= (vla-get-objectname entObj) "AcDbPolyline")
			       (vlax-curve-getPointAtDist
				 entObj
				 (/ (vlax-curve-getDistAtParam
				      entObj
				      (vlax-curve-getEndParam entObj)
				    )
				    2.0
				 )
			       )
			      )
			      (T nil)
			)
		 )
		 (setq inside? nil)
		 (setq j 0)
		 (while	(and (< j (sslength ssShapes)) (not inside?))
		   (setq shapeEnt (ssname ssShapes j))
		   (setq shapeObj (vlax-ename->vla-object shapeEnt))
		   (setq shapeType (cdr (assoc 0 (entget shapeEnt))))
		   (setq inside?
			  (cond
			    ((= shapeType "LWPOLYLINE")
			     (point-inside-polygon mid shapeObj)
			    )
			    ((= shapeType "CIRCLE")
			     (<	(distance mid (vlax-get shapeObj 'Center))
				(vlax-get shapeObj 'Radius)
			     )
			    )
			    (T nil)
			  )
		   )
		   (setq j (1+ j))
		 )
		 (if inside?
		   (entdel ent)
		 )
	  )
	  (progn
	    (setq
	      allIntPts	(append	(list (vlax-curve-getStartPoint ent))
				allIntPts
				(list (vlax-curve-getEndPoint ent))
			)
	    )
	    (setq allIntPts
		   (vl-sort allIntPts
			    (function
			      (lambda (a b)
				(< (vlax-curve-getDistAtPoint ent a)
				   (vlax-curve-getDistAtPoint ent b)
				)
			      )
			    )
		   )
	    )
	    (entdel ent)
	    (setq j 0)
	    (while (< j (1- (length allIntPts)))
	      (setq p1 (nth j allIntPts))
	      (setq p2 (nth (1+ j) allIntPts))
	      (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2))
	      (setq inside? nil)
	      (setq k 0)
	      (while (and (< k (sslength ssShapes)) (not inside?))
		(setq shapeEnt (ssname ssShapes k))
		(setq shapeObj (vlax-ename->vla-object shapeEnt))
		(setq shapeType (cdr (assoc 0 (entget shapeEnt))))
		(setq
		  inside? (cond
			    ((= shapeType "LWPOLYLINE")
			     (point-inside-polygon mid shapeObj)
			    )
			    ((= shapeType "CIRCLE")
			     (<	(distance mid
					  (vlax-get shapeObj 'Center)
				)
				(vlax-get shapeObj 'Radius)
			     )
			    )
			    (T nil)
			  )
		)
		(setq k (1+ k))
	      )
	      (if (not inside?)
		(entmakex (list	'(0 . "LINE")
				(cons 10 p1)
				(cons 11 p2)
				(cons 62 origColor)
			  )
		)
	      )
	      (setq j (1+ j))
	    )
	  )
	)
      )
    )
    (setq i (1+ i))
  )
  (prompt "\nDone trimming inside shapes.")
  (princ)
)

(princ "\nType 'TICS' to run the command.")

 

SLW210 Grand Master

SLW210

Posted
Posted

P.S. If you do need to do Ellipses there are some LISPs around to convert an Ellipse to a Pline and for Polyline Ellipse (2D Polyline) you can explode> Pedit>M (Multiple)>Join and this LISP will work.

 

That's what I did, it works pretty fast converting the Ellipses, probably why I didn't keep working on the complete LISP.

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Another give this a try, forgot yesterday to click on post, code was still there. Must be plines, checks for pline direction. may want to change the 20 dist val.

  

; https://www.cadtutor.net/forum/topic/98452-trim-lines-inside-rectangs/

(defun c:triminsiderect ( / oldsnap ss plent obj area1 area2 dist co-ord)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(princ "\n\Select closed plines \n")
(setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 70 1))))
(If ss 
(repeat (setq x (sslength ss))
(setq plent (ssname ss (setq x ( 1- x))))
(setq obj (vlax-ename->vla-object plent))
(setq dist  20.0)
(setq area1 (vlax-get obj 'Area))
(vla-offset obj dist)
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area2  (vlax-get objnew 'Area))
(if (> area1 area2)
  (progn
   (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
   (vla-delete (vlax-ename->vla-object (entlast)))
  )
  (progn
   (vla-offset obj (- dist))
   (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
   (vla-delete (vlax-ename->vla-object (entlast)))
  )
)
(setq co-ord (cons (last co-ord) co-ord))
(command "trim" plent "" "F" co-ord "" "")
)
)
(setvar 'osmode oldsnap)
(princ)
)
(c:trinsiderect)

 

Edited by BIGAL
SLW210 Grand Master

SLW210

Posted
Posted
On 6/26/2025 at 10:46 PM, BIGAL said:

Another give this a try, forgot yesterday to click on post, code was still there. Must be plines, checks for pline direction. may want to change the 20 dist val.

  

; https://www.cadtutor.net/forum/topic/98452-trim-lines-inside-rectangs/

(defun c:trinsiderect ( / oldsnap ss plent obj area1 area2 dist co-ord)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(princ "\n\Select closed plines \n")
(setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 70 1))))
(If ss 
(repeat (setq x (sslength ss))
(setq plent (ssname ss (setq x ( 1- x))))
(setq obj (vlax-ename->vla-object plent))
(setq dist  20.0)
(setq area1 (vlax-get obj 'Area))
(vla-offset obj dist)
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area2  (vlax-get objnew 'Area))
(if (> area1 area2)
  (progn
   (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
   (vla-delete (vlax-ename->vla-object (entlast)))
  )
  (progn
   (vla-offset obj (- dist))
   (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
   (vla-delete (vlax-ename->vla-object (entlast)))
  )
)
(setq co-ord (cons (last co-ord) co-ord))
(command "trim" plent "" "F" co-ord "" "")
)
)
(setvar 'osmode oldsnap)
(princ)
)
(c:trinsiderect)

 

I get an error with this after selecting closed polylines.

  

TrInsideRect.lsp successfully loaded.


Command:
Command:
Command: trinsiderect

Select closed plines

Select objects: Specify opposite corner: 15 found
3 were filtered out.

Select objects:
; error: Automation Error. Description was not provided.

 

BIGAL Grand Master

BIGAL

Posted
Posted

Not sure why it did not work for you, maybe remove the (cons 70 1). You can email me your test dwg.

 

Note what it did for the overlapping rectangs.

image.thumb.png.404162409dc0d7e3e1ea087fd4c21a93.png

SLW210 Grand Master

SLW210

Posted
Posted

I'll look into it.

 

My test drawing was practically the same as yours.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...