[Yêu Cầu] Cắt Đối Tượng Trong Khung

[nguyenducloi89 2]

Pro nào có thể giúp em không ạ, em muốn cắt các đối tượng trong khung như hình vẽ và copy các đối tượng và khung ra ngoài mà không ảnh hưởng đến bản vẽ. Chứ em cứ copy và paste ra rồi rồi xóa trim từng đoạn thằng một lâu quá. Em dùng cad2004 và 2007. Mong có cao thủ giúp em.Em cảm ơn nhiều.

[quocmanh04tt 638]

Lệnh EXTRIM (có cài Express).

[nguyenducloi89 2]

Lệnh EXTRIM (có cài Express).

;; free lisp from cadviet.com

;;;-----------------------

(defun SS-enlst	(ss / c L)

  (setq c -1)

  (repeat (sslength ss)

    (setq L (cons (ssname ss (setq c (1+ c))) L))

  )

  (reverse L)

)

;;;====================================================================

(defun break_with (Lstent enL /	lst masterlist ss oc break_obj intpts)

  (princ "\nCalculating Break Points, Please Wait.\n")

  

  ;;========================================

  ;; Break entity at break points in list

  ;;========================================



  (defun break_obj (ent	brkptlst   /	      brkobjlst	 en

			enttype	   maxparam   closedobj	 minparam

			obj	   obj2break  p1param	 p2param

			brkpt2	   dlst	      idx	 brkptS

			brkptE	   brkpt      result	 result

			ignore	   dist	      tmppt	 #ofpts

			enddist	   lastent    obj2break	 stdist

		       )

     (setq obj2break ent

	   brkobjlst (list ent)

	   enttype   (dxf 0 ent)

     )

    (if	(not (or (eq (dxf 0 obj2break) "TEXT")

		 (eq (dxf 0 obj2break) "MTEXT")

	     )

	)

      (setq closedobj (vlax-curve-isclosed obj2break))

    )

    (setq spt (vlax-curve-getstartpoint ent)

            ept (vlax-curve-getendpoint ent)

            brkptlst (vl-remove-if

                              '(lambda (x)

                                        (or (< (distance x spt) 0.0001)

                                             (< (distance x ept) 0.0001)

                                        )

                               )

                               brkptlst

                         )

    )

    (if	(and brkptlst

	     (not (or (eq (dxf 0 obj2break) "TEXT")

		      (eq (dxf 0 obj2break) "MTEXT")

		  )

	     )

	)

      (progn

	(setq brkptlst

	       (mapcar

		 '(lambda (x)

		    (list

		      x

		      (vlax-curve-getdistatparam

			obj2break

			(cond

			  ((vlax-curve-getparamatpoint obj2break x)

			  )

			  ((vlax-curve-getparamatpoint

			     obj2break

			     (vlax-curve-getclosestpointto

			       obj2break

			       x

			     )

			   )

			  )

			)

		      )

		    )

		  )

		 brkptlst

	       )

	)



	(setq

	  brkptlst (vl-sort brkptlst

			    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))

		   )

	)



	(foreach brkpt (reverse brkptlst)

	    (setq brkptS (car brkpt)

		  brkptE brkptS

	    )

	  ;; get last entity created via break in case multiple breaks

	  (if brkobjlst

	    (progn

	      (setq tmppt brkptS); use only one of the pair of breakpoints

	      ;; if pt not on object x, switch objects

	      (if (not (numberp	(vl-catch-all-apply

				  'vlax-curve-getdistatpoint

				  (list obj2break tmppt)

				)

		       )

		  )

		(; find the one that pt is on

		  (setq idx (length brkobjlst))

		  (while

		    (and (not (minusp (setq idx (1- idx))))

			 (setq obj (nth idx brkobjlst))

			 (if (numberp (vl-catch-all-apply

					'vlax-curve-getdistatpoint

					(list obj tmppt)

				      )

			     )

			   (null (setq obj2break obj))

; switch objects, null causes exit

			   t

			 )

		    )

		  )

		)

	      )

	    )

	  ); end (if brkobjlst

	  

	  ;;; Handle any objects that can not be used with the Break Command

	  ;;; using one point, gap of 0.000001 is used

	  (if (not (or (eq (dxf 0 obj2break) "TEXT")

		       (eq (dxf 0 obj2break) "MTEXT")

		   )

	      )

	    (setq closedobj (vlax-curve-isclosed obj2break))

	  )

;;; single breakpoint ----------------------------------------------------

	    (if

	      (and closedobj

		   (not	(setq

			  brkptE (vlax-curve-getPointAtDist

				   obj2break

				   (+ (vlax-curve-getdistatparam

					obj2break

;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))

;; ver 2.0 fix

					(cond

					  ((vlax-curve-getparamatpoint

					     obj2break

					     brkpts

					   )

					  )

					  ((vlax-curve-getparamatpoint

					     obj2break

					     (vlax-curve-getclosestpointto

					       obj2break

					       brkpts

					     )

					   )

					  )

					)

				      )

				      0.00001

				   )

				 )

			)

		   )

	      )

	       (setq

		 brkptE	(vlax-curve-getPointAtDist

			  obj2break

			  (- (vlax-curve-getdistatparam

			       obj2break

			       (cond ((vlax-curve-getparamatpoint

					obj2break

					brkpts

				      )

				     )

				     ((vlax-curve-getparamatpoint

					obj2break

					(vlax-curve-getclosestpointto

					  obj2break

					  brkpts

					)

				      )

				     )

			       )

			     )

			     0.00001

			  )

			)

	       ); end setq brkptE

	    ); end fi (and closedobj



	  ;; (if (null brkptE) (princ)) ; debug

	  (setq LastEnt (GetLastEnt))

	  (if (not (or (eq (dxf 0 obj2break) "TEXT")

		       (eq (dxf 0 obj2break) "MTEXT")

		   )

	      )

	    (command "._break"

		     obj2break

		     "_non"

		     (trans brkptS 0 1)

		     "_non"

		     (trans brkptE 0 1)

	    )

	  )

	  (and (= "CIRCLE" enttype) (setq enttype "ARC"))

	  (if (and (not closedobj); new object was created

		   (not (equal LastEnt (entlast)))

	      )

	    (setq brkobjlst (cons (entlast) brkobjlst))

	  ); end (if (and

	); end (foreach brkpt

      );end progn brkptlst

    ); end if brkptlst



  ); defun break_obj



  ;;====================================

  ;; CAB - get last entity in datatbase

  (defun GetLastEnt (/ ename result)

    (if	(setq result (entlast))

      (while (setq ename (entnext result))

	(setq result ename)

      )

    )

    result

  )

  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  ;; S T A R T              S U B R O U T I N E             H E R E

  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



 (if (and Lstent enL)

    (progn

      ;; CREATE a list of entity & it's break points

      (foreach en Lstent

; check each object in Lstent

	(if (not (acet-layer-locked (dxf 8 en)))

	  (progn

	    (setq lst nil)

	    ;; check for break pts with other objects in Lstentwith

	    (if	(and (not (equal en enint))

		     (setq intpts (acet-geom-intersectwith en enL 0))

		)

	      (setq lst (append intpts lst))

; entity w/ break points

	    )

	    (if	lst

	      (setq masterlist

		     (cons (cons en lst) masterlist)

	      )

	    )

	  )

	)

      )

      (princ "\nBreaking Objects.\n")

      (if masterlist

	(foreach obj2brk masterlist

	  (break_obj (car obj2brk) (cdr obj2brk))

	)

      )

    )

  )

);end break_with

;;===========================================================================

;; get all objects touching entities in the sscross

;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

;; returns a list of enames

;;===========================================================================

(defun gettouching (en / ss lst lstb lstc objl)

  (and

    (setq objl (vlax-ename->vla-object en))

    (setq

      ss

       (ssget

	 "_A"

	 (list

	   (cons 0

		 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

	   )

	   (cons 410 (getvar "ctab"))

	 )

       )

    )

    (setq lst (SS-enlst ss)

     lst (mapcar 'vlax-ename->vla-object lst))

    (mapcar

      '(lambda (x)

	 (if (not

	       (vl-catch-all-error-p

		 (vl-catch-all-apply

		   '(lambda ()

		      (vlax-safearray->list

			(vlax-variant-value

			  (vla-intersectwith objl x acextendnone)

			)

		      )

		    )

		 )

	       )

	     )

	   (setq lstc (cons (vlax-vla-object->ename x) lstc))

	 )

       )

      lst

    )

  )

  lstc

)

;;;------------------------------------------------

(defun LWP (Lpoint *Model* / PntArr)

  (setq	PntArr (vlax-make-safearray

		 vlax-vbDouble

		 (cons 0 (1- (length Lpoint)))

	       )

  )

  (vlax-safearray-fill PntArr Lpoint)

  (vla-AddLightWeightPolyline *Model* PntArr)

)

;;;------------------------------------------------

(defun DXF (code en) (cdr (assoc code (entget en))))

;;;============================================================

;;;=======================MAIN LISP============================

;;;============================================================

(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
  (vl-load-com)	

  (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))

	*Model*	(vla-get-ModelSpace ActDoc)

  )

  (vla-StartUndoMark ActDoc)

  (setq	a (getreal "\n Nhap kich thuoc chieu dai: "))

  (setq	b (getreal "\n Nhap kich thuoc chieu rong "))

  (setq	emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))

  (setvar "cecolor" "104")

  (setq	lstp (list (car emin)

		   (cadr emin)

		   (+ (car emin) a)

		   (cadr emin)

		   (+ (car emin) a)

		   (+ (cadr emin) B)

		   (car emin)

		   (+ (cadr emin) B)

	     )

  )

  (vla-put-closed (LWP lstp *Model*) :vlax-True)

  (setq ss (ssadd (entlast) (ssadd)))

  (setq	p2 (ACET-SS-DRAG-MOVE

	     ss

	     (list (car emin) (cadr emin))

	     "Chon vi tri bat dau trich thua: "

	   )

  )

  (command ".move" ss "" emin p2)

  (setq encur (entlast)

	lstp (acet-geom-VERTEX-LIST encur))

  (setq ss (ssdel encur (ssget "_CP" lstp)))

  (command ".copy" ss "" p2 p2)

  (setq	p3 (ACET-SS-DRAG-MOVE

	     (ssadd encur ss)

	     p2

	     "Chon vi tri dat ban do trich thua: "

	   )

  )

  (command ".move" ss encur "" p2 p3)

  (setvar "cecolor" "0")

  (setq encur (ssname (ssget "X" '((62 . 104))) 0))

  (setq	lstobj1	(vl-remove encur (gettouching encur))

	ss	(acet-list-to-ss lstobj1)

  )

  (acet-ss-zoom-extents ss)

  (break_with  lstobj1 encur)

  (vlax-invoke-method ActDoc 'Regen acActiveViewport)

  (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))

  (setq lst3 (acet-geom-vertex-list (entlast)))

  (entdel (entlast))

  (setq	LenssBR	(SS-enlst (ssget "F" lst3)))

  (foreach x LenssBR

    (if	(or (not (eq (dxf 0 x) "TEXT"))

	    (not (eq (dxf 0 x) "MTEXT"))

	)

      (entdel x)

    )

  )

  (vla-EndUndoMark ActDoc)
  (princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")

)

Mình muốn cắt như code của anh Duân, nhưng mà sẽ là select object vào một cái khung rồi cắt theo khung. Pro nào giúp được không nhỉ.