Chuyển đến nội dung
Diễn đàn CADViet
cadbeginer

Cần một lisp cắt khung chuyên nghiệp

Bởi cadbeginer , trong AutoLisp

Các bài được khuyến nghị

cadbeginer    1

cadbeginer
Đã đăng

Tôi có một bản đồ quy hoạch của một thành phố, vấn đề ở chỗ là tôi phải chia nhỏ bản đồ đó ra thành nhiều mảnh theo các khung vẽ để thể hiện chi tiết các đường ống và các thiết bị cấp nước. Có khi đến vài trăm khung nhỏ, gọi là bản đồ phân mảnh. Nếu ta đặt từng khung nhỏ vào bản đồ rồi Trim thì rất là lâu, có lisp nào có thể cắt được từng khung không?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Tôi có một bản đồ quy hoạch của một thành phố, vấn đề ở chỗ là tôi phải chia nhỏ bản đồ đó ra thành nhiều mảnh theo các khung vẽ để thể hiện chi tiết các đường ống và các thiết bị cấp nước. Có khi đến vài trăm khung nhỏ, gọi là bản đồ phân mảnh. Nếu ta đặt từng khung nhỏ vào bản đồ rồi Trim thì rất là lâu, có lisp nào có thể cắt được từng khung không?

Lisp của bạn đây. Mong là đúng với ý bạn

;; 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)
			)
	       )
	  )
	(progn			; 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)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq	a (cond	(a)
	(50)
  )
 )
 (setq olda a)
 (setq	a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
			   (rtos olda 2 1)
			   "> : ")))
 (if (null a) (setq a olda))
 (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) a)
	   (car emin)
	   (+ (cadr emin) a)
     )
 )
 (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")
)

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

lp_hai    225

lp_hai
Đã đăng

cái này thuộc về kthuat autocad rồi ban ah

bạn biết xài Xref ko nè.

bạn nên tạo file dó là file nguồn, rồi xref nó vào file bv, sau đó dùng lệnh clipit cắt nó theo đường bao mà bạn muốn

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cadbeginer    1

cadbeginer
Đã đăng

Cẳm ơn bác thanhduan2407 rất nhiều, nhưng lisp này có cắt được khung bất kỳ không? khung chữ nhật chẳng hạn vì mỗi một khung cắt sau này sẽ là 1 bản vẽ để in

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cadbeginer    1

cadbeginer
Đã đăng

Cẳm ơn bác thanhduan2407 rất nhiều, nhưng lisp này có cắt được khung bất kỳ không? khung chữ nhật chẳng hạn vì mỗi một khung cắt sau này sẽ là 1 bản vẽ để in

Có lẽ mình sẽ gửi file nên cho mọi người cùng xemMy link

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Cẳm ơn bác thanhduan2407 rất nhiều, nhưng lisp này có cắt được khung bất kỳ không? khung chữ nhật chẳng hạn vì mỗi một khung cắt sau này sẽ là 1 bản vẽ để in

Bạn copy trichthua này thay vào chỗ cũ là được

(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
 (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")
)

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.984

ketxu
Đã đăng

cac cao thu dau het roi?

Câu này của bạn quả đã làm phụ lòng bác thanhduan bên trên.Hơn nữa, cũng chẳng phải chỉ cao thủ mới giúp được bạn, hoặc đâu có lẽ cao thủ mới bỏ thời gian giúp bạn, hoặc có người nhận mình là cao thủ mới dám giúp bạn ? Bạn đã thử lại đoạn lisp bác ấy gửi phía sau chưa?? Đừng lờ đi 1 sự giúp đỡ nào, dù là nhỏ nhất :)

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cadbeginer    1

cadbeginer
Đã đăng

Câu này của bạn quả đã làm phụ lòng bác thanhduan bên trên.Hơn nữa, cũng chẳng phải chỉ cao thủ mới giúp được bạn, hoặc đâu có lẽ cao thủ mới bỏ thời gian giúp bạn, hoặc có người nhận mình là cao thủ mới dám giúp bạn ? Bạn đã thử lại đoạn lisp bác ấy gửi phía sau chưa?? Đừng lờ đi 1 sự giúp đỡ nào, dù là nhỏ nhất :)

Bác ketxu lại làm phức tạp hóa vấn đề nên rồi, đây là một diễn đàn để chia sẻ và mời gọi mọi ngưòi cùng nhau chia sẻ. Gia chủ không có ý đó nhưng tại sao bác lại quy chụp gia chủ như vậy? mình đã cảm ơn bác thanhduan và muốn có một cái lisp hoàn hảo hơn, cái lisp đó ko chỉ có một mình cần mà còn có những người của diễn đàn cadviet đang cần và còn những người sau này chưa biết đến diễn đàn vào diễn đàn sẽ thấy một tinh thần chia sẻ của chúng ta. Mình nói vậy có đúng không bạn. Câu nói "các cao thủ đâu rồi" là một câu nói vui để mọi người cùng phát triển ý tưởng, vì mỗi một câu hỏi đều là một ý tưởng để chúng ta lưu ý. Giống như là khi ta hát, ta có phải là ca sĩ đâu mà bạn bè gọi là ca sĩ? Phải không bác?

  • Vote giảm 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.984

ketxu
Đã đăng

Bạn copy trichthua này thay vào chỗ cũ là được

[/code]

cac cao thu dau het roi?

Vì 2 cái này xếp cạnh nhau, và cách nhau 8 tiếng, nên người đọc hiểu là bạn chưa check thử cái lisp bên trên, kiểu như là có người giơ quà tặng bên cạnh bạn nhưng bạn ngó ra xa rồi hỏi "có ai cho tôi không" ý ^^ ket cũng hiểu như thế mà. Biết là bạn không có ý như thế, nhưng vô tình làm cho người post bên trên cảm thấy hụt hẫng, nên góp ý vs bạn th :)

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Vì 2 cái này xếp cạnh nhau, và cách nhau 8 tiếng, nên người đọc hiểu là bạn chưa check thử cái lisp bên trên, kiểu như là có người giơ quà tặng bên cạnh bạn nhưng bạn ngó ra xa rồi hỏi "có ai cho tôi không" ý ^^ ket cũng hiểu như thế mà. Biết là bạn không có ý như thế, nhưng vô tình làm cho người post bên trên cảm thấy hụt hẫng, nên góp ý vs bạn th :)

Cảm ơn Ketxu và cadbeginer đã cùng nhau góp ý trên diễn đàn. Vì Cadbeginer cũng mới tham gia diễn đàn nên còn nhiều bỡ ngỡ (Ví dụ như viết không có dấu: cac cao thu dau het roi?). Có thể Cadbeginer chưa biết nên mới nói vậy chứ không có ý. :lol: . Chúc cho diễn đàn của chúng ta luôn nóng hổi tin vui.

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cadbeginer    1

cadbeginer
Đã đăng

Cảm ơn Ketxu và cadbeginer đã cùng nhau góp ý trên diễn đàn. Vì Cadbeginer cũng mới tham gia diễn đàn nên còn nhiều bỡ ngỡ (Ví dụ như viết không có dấu: cac cao thu dau het roi?). Có thể Cadbeginer chưa biết nên mới nói vậy chứ không có ý. :lol: . Chúc cho diễn đàn của chúng ta luôn nóng hổi tin vui.

Cảm ơn bạn rất rất nhiều, :rolleyes: :rolleyes:

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

bác thanhduan ơi, em đã test thử rồi nó báo lỗi là ; error: no function definition: LWP

http://www.cadviet.com/upfiles/3/trichthua_1.lsp

Bạn down về chạy nhé. Mình chạy vẫn mượt mà. Lisp này mình cũng xin được và chỉnh sửa có tẹo à. Lisp còn hạn chế cắt khung 3D nên không cắt được các đối tượng có độ cao khác không. Nếu bạn cài Express tool rồi thì dùng lệnh flatten để đưa các đối tượng về 2D nhé. À, Ketxu là một cao thủ lập trình đó, tuy không dám nhận nhưng đang cày thành dân chơi đó, bạn nên nhấn nút thanks (có dấu +) ở dưới nhé để cảm ơn.

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

congthai_uce    2

congthai_uce
Đã đăng

Tôi có một bản đồ quy hoạch của một thành phố, vấn đề ở chỗ là tôi phải chia nhỏ bản đồ đó ra thành nhiều mảnh theo các khung vẽ để thể hiện chi tiết các đường ống và các thiết bị cấp nước. Có khi đến vài trăm khung nhỏ, gọi là bản đồ phân mảnh. Nếu ta đặt từng khung nhỏ vào bản đồ rồi Trim thì rất là lâu, có lisp nào có thể cắt được từng khung không?

Tôi cũng hay in trắc dọc đường

Theo tôi là dùng in trong Layout là OK nhất,Nếu có nhiều ô quá thì làm nhiều khung nhìn tý.Nhớ là đừng làm nhiều quá, bản vẽ sẽ nặng.

Have fun

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

canhochoi    0

canhochoi
Đã đăng

Minh thấy Lisp "Trichthua" của Advance Member cũng hay, nhưng trong trường hợp này với bản vẽ có XREF nền sẽ không cắt được do đó

banh có thể trích vùng chọn sang layout thì có lẽ hay hơn

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

tientracdia    16

tientracdia
Đã đăng

Bạn copy trichthua này thay vào chỗ cũ là được



(car emin)


(+ (cadr emin) cool.gif


)


)


(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")


)




 




Lisp trichthua rất hay, thanks;


Mình muốn nhờ anh anh bổ sung thêm cho cho việc xử lý khi trích khu vưc cần trích save ra file cần lưu trong thư mục đó và đúng tọa độ theo bản vẽ gốc.



			
		


		

			
				
					

	
	
		

			
				
				

					
				

			
			
			
		

	


				
			
			
    
				
					
					
					
				
				
  • 
					
				
    • 
			

		


		
	


	

		

			
Chia sẻ bài đăng này

			

			
Liên kết tới bài đăng

			
			
			

			
				
Chia sẻ trên các trang web khác

				

	

			
		

	



	



					
				
			
			



		

	


	

	
		
		

			
				
				





	
	
		

			
				
Tạo một tài khoản hoặc đăng nhập để nhận xét

				
Bạn cần phải là một thành viên để lại một bình luận

			
	
			

				

					

						
Tạo tài khoản

						
Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

						
							
						
						Đăng ký tài khoản mới
					

					

						
Đăng nhập

						
Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

						Đăng nhập ngay
					

				

			

		

	


			
		

	

	
		

			


		

		

			



		

	







	

		
			
				Về Đầu Trang
				AutoLisp
			
		
	

	




	

	

	




						


					

					


					

				

			

			
		

		
		


	×