Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
cadbeginer

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

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

cadbeginer    1

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    226

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    207

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

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

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    226

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.649

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

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.649

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    226

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

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    226

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

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

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    11

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


×