Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
namhai

lisp xóa tất cả các đối tượng trong 1 vùng kín

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

e muốn xoá tất cả các đối tượng trong 1 vùng kín nhưng phải làm thủ công bằng lệnh trim và erase, như vậy rất mất công và tốn thời gian, bác nào có cách nào giúp e giải quyết vấn đề này 1 cách nhanh chóng 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
e muốn xoá tất cả các đối tượng trong 1 vùng kín nhưng phải làm thủ công bằng lệnh trim và erase, như vậy rất mất công và tốn thời gian, bác nào có cách nào giúp e giải quyết vấn đề này 1 cách nhanh chóng không?

 

Mình không biết viết lisp. nhưng có vài cách giúp bạn đỡ thủ công hơn.

1. Dùng lệnh Trim với tham số f.

2. Bạn dùng lệnh extrim của express tool

cả 2 lệnh trên vẫn kết hợp vơi Erase nhưng nhanh hơn rất nhiều.

3. Dùng wipeout để che đi tất cả đối tượng trong vùng kín. Mình nghĩ cách này giải quyết tốt nhất vấn đề của bạ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
Mình không biết viết lisp. nhưng có vài cách giúp bạn đỡ thủ công hơn.

1. Dùng lệnh Trim với tham số f.

2. Bạn dùng lệnh extrim của express tool

cả 2 lệnh trên vẫn kết hợp vơi Erase nhưng nhanh hơn rất nhiều.

3. Dùng wipeout để che đi tất cả đối tượng trong vùng kín. Mình nghĩ cách này giải quyết tốt nhất vấn đề của bạn.

Minh vẫn đang dùng cách này nhưng trong trường hợp cần xoá nhiều đối tượng thì vẫn thủ công quá, nó chỉ hữu ích khi các đường mìng cần xoá cắt với đường bao tạo nên vùng kín đấy, còn dùng wipeout chỉ là che các đối tượng, cái mình muốn là xoá hẳn các đối tượng đấy đi!!

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
Minh vẫn đang dùng cách này nhưng trong trường hợp cần xoá nhiều đối tượng thì vẫn thủ công quá, nó chỉ hữu ích khi các đường mìng cần xoá cắt với đường bao tạo nên vùng kín đấy, còn dùng wipeout chỉ là che các đối tượng, cái mình muốn là xoá hẳn các đối tượng đấy đi!!

Bạn chọn đối tượng bằng Window bấm S rùi CP sao đó vẽ dọc theo hình kín đó là chọn được các đối tượng trong hình rùi E thế là ok !!!

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
e muốn xoá tất cả các đối tượng trong 1 vùng kín nhưng phải làm thủ công bằng lệnh trim và erase, như vậy rất mất công và tốn thời gian, bác nào có cách nào giúp e giải quyết vấn đề này 1 cách nhanh chóng không?

Đây là lisp bạn cần:

;;;-------------------------------------------------------------
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
   (entdel (ssname ssgDEL n))
   (setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

Không phải xóa thủ công nữa nhé.

  • Vote tăng 5

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
Bạn chọn đối tượng bằng Window bấm S rùi CP sao đó vẽ dọc theo hình kín đó là chọn được các đối tượng trong hình rùi E thế là ok !!!

sau khi minh chọn đối tượng theo cách của bạn được rồi mình đánh lệnh e để xoá thì không được, theo cách bạn làm có phải chỉ để chọn đối tượng, còn lệnh erase thì phải thực hiện sau?

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
Đây là lisp bạn cần:

;;;-------------------------------------------------------------
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
   (entdel (ssname ssgDEL n))
   (setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

Không phải xóa thủ công nữa nhé.

Bác Thiệp à, lisp của bác tuyệt vời quá, e thanks bác nhiều nhé! tiện đây bác giúp e lisp xoá các đối tượng nằm ngoài vùng kín với đưọc không ạ?

  • Vote tăng 3

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
Bác Thiệp à, lisp của bác tuyệt vời quá, e thanks bác nhiều nhé! tiện đây bác giúp e lisp xoá các đối tượng nằm ngoài vùng kín với đưọc không ạ?

Lisp trên hiểu cả các đường Cur không kín, còn đây lisp xóa các đối tượng ngoài Cur:

;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e)
 (setq	i  0
Le nil
 )
 (repeat (sslength ss)
   (setq
     e	 (ssname ss i)
     Le (append Le (list e))
     i	 (1+ i)
   )
 )
 Le
)
;--------------------------
(defun C:eoC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nChon duong curve: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 (setq ssall (ssget "X")
       ssginC (ssget "WP" L)
enssginC (ss2ent ssginC))
 (foreach eni enssginC
   (ssdel eni ssall)
   )
 (setq n 0)
 (repeat (sslength ssall)
   (entdel (ssname ssall n))
   (setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep")
 (princ)
)
(vl-load-com)

  • 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

Bác Thiep oi, dựa trên 2 lệnh xóa trên thì bác có thể chỉnh xửa 1 chút để khi chạy thì chương trình dùng đúng trong mọi trường hợp. Em đề xuất bác có thể lồng lệnh extrim vào trong 2 lệnh trên để người dùng chỉ cần vẽ 1 đường pline khép kín thì chương trình sẽ xóa tại giao điểm cắt của đường pline kín. Em cá mơn Bác nhiều.

Đây là file cad mẫu nhờ bác Thiep ngâm cứu hộ

http://www.cadviet.com/upfiles/mau_4.dwg

( Xin lỗi Bác do em không biết viết lisp, nên có gì sai xót mong Bác thông cảm bỏ qua)

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
Bác Thiep oi, dựa trên 2 lệnh xóa trên thì bác có thể chỉnh xửa 1 chút để khi chạy thì chương trình dùng đúng trong mọi trường hợp. Em đề xuất bác có thể lồng lệnh extrim vào trong 2 lệnh trên để người dùng chỉ cần vẽ 1 đường pline khép kín thì chương trình sẽ xóa tại giao điểm cắt của đường pline kín. Em cá mơn Bác nhiều.

Đây là file cad mẫu nhờ bác Thiep ngâm cứu hộ

http://www.cadviet.com/upfiles/mau_4.dwg

( Xin lỗi Bác do em không biết viết lisp, nên có gì sai xót mong Bác thông cảm bỏ qua)

Thiep có thể gộp 2 Lisp trên lại thành 1. Lisp yêu cầu thêm: xóa các đối tượng trong hay ngoài CUR.

Còn lồng thêm lệnh extrim thì thiep không làm được như yêu cầu, vì trong lisp extrim có những hàm được viết sẵn bằng ObjectARX, không hiểu được bên trong là cái gì. Chịu, cái hiện nay thiep còn bí là:

- Làm sao Lisp hiểu được mình pick trong hay ngoài đường CUR

- Trong extrim.lsp, các listpoint (lst, lst2...) được tạo như thế nào.

Chắc nhờ bác Hoành, VNdoc, hay các bậc cao thủ khác am hiểu về ObjectARX viết tiếp thôi.

Tuy nhiên, thiep chỉ thêm một động tác gọi lệnh extrim trước để xén các đối tượng cắt ngang qua CUR, bên trong hay bên ngoài. còn sau đó, sẽ thực hiện lisp cua Thiep. Lisp erc.lsp đã chỉnh sửa:

;; ERC.LSP free lisp from cadviet.com
;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e)
(setq i 0
Le nil
)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(defun c:erc (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (vl-load-all "C:/Program Files/AutoCAD 2007/Express/extrim.lsp")
 (c:extrim)
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 (setq n 0)
 (initget "T N")
 (setq bit (getkword "\nBan muon xoa Trong hay Ngoai Curve < T/N>: "))
 (cond	((= bit "T")
 (setq ssgDEL (ssget "WP" L))
)
((= bit "N")
 (progn
   (setq ssgDEL	  (ssget "X")
	 ssginC	  (ssget "CP" L)
	 enssginC (ss2ent ssginC)
   )
   (foreach eni	enssginC
     (ssdel eni ssgDEL)
   )
 )
)
 )
 (repeat (sslength ssgDEL)
   (entdel (ssname ssgDEL n))
   (setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

 

Ngày cuối tuàn vui vẻ!.

  • Vote tăng 4

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

Cá mơn Thiep rất nhiều, mong các cao thủ về lisp có thể nghe vô để hoàn thiện lisp này. Thank mọi người nhiều. Chúc mọi người cuối tuần vui vẻ :blink: :s_big: :blink:

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
Thiep có thể gộp 2 Lisp trên lại thành 1. Lisp yêu cầu thêm: xóa các đối tượng trong hay ngoài CUR.

Còn lồng thêm lệnh extrim thì thiep không làm được như yêu cầu, vì trong lisp extrim có những hàm được viết sẵn bằng ObjectARX, không hiểu được bên trong là cái gì. Chịu, cái hiện nay thiep còn bí là:

- Làm sao Lisp hiểu được mình pick trong hay ngoài đường CUR

- Trong extrim.lsp, các listpoint (lst, lst2...) được tạo như thế nào.

Chắc nhờ bác Hoành, VNdoc, hay các bậc cao thủ khác am hiểu về ObjectARX viết tiếp thôi.

Tuy nhiên, thiep chỉ thêm một động tác gọi lệnh extrim trước để xén các đối tượng cắt ngang qua CUR, bên trong hay bên ngoài. còn sau đó, sẽ thực hiện lisp cua Thiep. Lisp erc.lsp đã chỉnh sửa:

Cái này đơn giản thôi mà! Bạn có thể đọc mã nguồn của extrim.lsp để hiểu nó.

 

Bạn thay dòng lệnh (c:extrim) bằng (etrim ent p) là bạn có thể 'lồng' vào lệnh extrim được rồi.

 

Hàm etrim với 2 tham số, tham số thứ nhất là entity name của đối tượng, tham số thứ hai là điểm pick.

Ta có thể biết cách dùng lệnh etrim qua ví dụ dưới đây:

(vl-load-all "C:/Program Files/AutoCAD 2007/Express/extrim.lsp")
(defun c:myextrim( / ent p)
(setq 
ent (car (entsel "\nHay chon doi tuong: ")) 
p (getpoint "\nHay pick vao phia can trim: ")
)
(etrim ent p)
)

  • Vote tăng 3

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

Hình như lisp trên không xoá được các đối tượng nằm trong khu vực được giới hạn bởi 2 vùng kín(chẳng hạn e chỉ muốn xoá các đối tượng trong hình vành khăn tức là đối tượng được giới hạn bởi 2 đường tròn đồng tâm có bán kính khác nhau), mong các cao thủ ra tay giúp đỡ

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
Hình như lisp trên không xoá được các đối tượng nằm trong khu vực được giới hạn bởi 2 vùng kín(chẳng hạn e chỉ muốn xoá các đối tượng trong hình vành khăn tức là đối tượng được giới hạn bởi 2 đường tròn đồng tâm có bán kính khác nhau), mong các cao thủ ra tay giúp đỡ

Nanhai à, vì ban đầu bạn chỉ yêu cầu xóa các đối tượng trong 1 curve.

Sau đó thì Nanhai yêu cầu thêm xóa các đối tượng ngoài 1 curve.

Bây giờ thì yêu cầu thêm xóa các đối tượng giữa 2 curve, chứ không có "hình như" bạn ạ

Thiep sẽ chỉnh sửa Lisp theo cả 3 yêu cầu này cho bạn.

Nhớ lần sau Namhai ra đầu đề 1 lần thôi, khỏi phải viết đi viết lại nhiều lần bạn nhé?

Lisp đã chỉnh sửa:

;; ERC.LSP free lisp from cadviet.com
;; copyright by Thiep,06/2009
;;;----------------------------
(defun ss2ent (ss / i Le e)
(setq i 0
Le nil
)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-----------------------------------
(defun fen (cur / sc glength d l1 p0)
 (setq	sc	2009
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 L
)
;;;---------------------------------------------------
(defun c:er2c (/ cur L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
				;-------------------
 (acet-error-init
   (list
     (list "cmdecho"	0	    "highlight"	0	    "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
				;--------------------
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq n 0)
 (initget "T N G")
 (setq	bit
 (getkword
   "\nBan muon xoa Trong hay Ngoai 1 Curve, hay giua 2 Curve < T/N/G>: "
 )
 )
 (cond	((= bit "T")
 (setq cur    (car (entsel "\nChon curve: "))
       L      (fen cur)
       ssgDEL (ssget "WP" L)
 )
)
((= bit "N")
 (setq cur	(car (entsel "\nChon curve: "))
       L	(fen cur)
       ssgDEL	(ssget "X")
       ssginC	(ssget "CP" L)
       enssginC	(ss2ent ssginC)
 )
 (foreach eni enssginC
   (ssdel eni ssgDEL)
 )
)
((= bit "G")
 (setq cur1	 (car (entsel "\nChon curve ngoai: "))
       L1	 (fen cur1)
       ssgDEL	 (ssget "WP" L1)
       cur2	 (car (entsel "\nChon curve trong: "))
       L2	 (fen cur2)
       ssginC2	 (ssget "CP" L2)
       enssginC2 (ss2ent ssginC2)
 )
 (foreach eni enssginC2
   (ssdel eni ssgDEL)
 )
)
 )
 (repeat (sslength ssgDEL)
   (if	(and (/= (ssname ssgDEL n) cur2) (/= (ssname ssgDEL n) cur1))
     (progn
(entdel (ssname ssgDEL n))
(setq n (1+ n))
     )
   )
 )
 (command "undo" "end")
 (acet-error-restore)
 (princ
   "\nChuc cac ban may man va thanh cong - Thiep 0918841230"
 )
 (princ)
)
(vl-load-com)

  • Vote tăng 3

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

Nhờ Bác Thiep coi lại dùm em Lisp er2c nó báo lỗi không chạy được.

-Command: er2c

Free lisp from www.cadviet.com

too many arguments

Đây là file cad mẫu:

http://www.cadviet.com/upfiles/mau1.dwg

 

Tiện thể Bác cho em hỏi Lisp xoá các đối tượng bên trong hoặc bên ngoài 1 đường Pline kép kín có lồng thêm lệnh Extrim Bác đã viết xong chưa vậy? Nếu viết xong rồi thì em cá mơn Bác nhiều lắm. Thank Bác nhiều.

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
Nhờ Bác Thiep coi lại dùm em Lisp er2c nó báo lỗi không chạy được.

-Command: er2c

Free lisp from www.cadviet.com

too many arguments

Đây là file cad mẫu:

http://www.cadviet.com/upfiles/mau1.dwg

 

Tiện thể Bác cho em hỏi Lisp xoá các đối tượng bên trong hoặc bên ngoài 1 đường Pline kép kín có lồng thêm lệnh Extrim Bác đã viết xong chưa vậy? Nếu viết xong rồi thì em cá mơn Bác nhiều lắm. Thank Bác nhiều.

Bạn thư lại đi,

trước đây bị lỗi phần download

  • 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
Nhờ pác Thiệp xem lại. Lisp er2c.lsp bị lỗi không chạy dc.

Bị lỗi như thế này. Lisp của bác thật tuyệt. Thanks bác nhiều nhiều.

Command: er2c

Free lisp from www.cadviet.com; error: no function definition: ACET-ERROR-INIT

Command:

Chào xataraku

hàm ACET-ERROR-INIT thuộc thư viện Express Tool.

bạn phải cài bộ Express Tool thì LISP er2c mới chạy đuợc.

  • 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
Nanhai à, vì ban đầu bạn chỉ yêu cầu xóa các đối tượng trong 1 curve.

Sau đó thì Nanhai yêu cầu thêm xóa các đối tượng ngoài 1 curve.

Bây giờ thì yêu cầu thêm xóa các đối tượng giữa 2 curve, chứ không có "hình như" bạn ạ

Thiep sẽ chỉnh sửa Lisp theo cả 3 yêu cầu này cho bạn.

Nhớ lần sau Namhai ra đầu đề 1 lần thôi, khỏi phải viết đi viết lại nhiều lần bạn nhé?

Lisp đã chỉnh sửa:

;; ERC.LSP free lisp from cadviet.com
;; copyright by Thiep,06/2009
;;;----------------------------
(defun ss2ent (ss / i Le e)
(setq i 0
Le nil
)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-----------------------------------
(defun fen (cur / sc glength d l1 p0)
 (setq	sc	2009
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
   (setq
     l1 (+ l1 d)
     p1 (vlax-curve-getPointAtDist cur l1)

   )
   (setq L (append L (List p1)))
 )
 L
)
;;;---------------------------------------------------
(defun c:er2c (/ cur L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
				;-------------------
 (acet-error-init
   (list
     (list "cmdecho"	0	    "highlight"	0	    "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
				;--------------------
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq n 0)
 (initget "T N G")
 (setq	bit
 (getkword
   "\nBan muon xoa Trong hay Ngoai 1 Curve, hay giua 2 Curve < T/N/G>: "
 )
 )
 (cond	((= bit "T")
 (setq cur    (car (entsel "\nChon curve: "))
       L      (fen cur)
       ssgDEL (ssget "WP" L)
 )
)
((= bit "N")
 (setq cur	(car (entsel "\nChon curve: "))
       L	(fen cur)
       ssgDEL	(ssget "X")
       ssginC	(ssget "CP" L)
       enssginC	(ss2ent ssginC)
 )
 (foreach eni enssginC
   (ssdel eni ssgDEL)
 )
)
((= bit "G")
 (setq cur1	 (car (entsel "\nChon curve ngoai: "))
       L1	 (fen cur1)
       ssgDEL	 (ssget "WP" L1)
       cur2	 (car (entsel "\nChon curve trong: "))
       L2	 (fen cur2)
       ssginC2	 (ssget "CP" L2)
       enssginC2 (ss2ent ssginC2)
 )
 (foreach eni enssginC2
   (ssdel eni ssgDEL)
 )
)
 )
 (repeat (sslength ssgDEL)
   (if	(and (/= (ssname ssgDEL n) cur2) (/= (ssname ssgDEL n) cur1))
     (progn
(entdel (ssname ssgDEL n))
(setq n (1+ n))
     )
   )
 )
 (command "undo" "end")
 (acet-error-restore)
 (princ
   "\nChuc cac ban may man va thanh cong - Thiep 0918841230"
 )
 (princ)
)
(vl-load-com)

Bác Thiếp à,,sory bác vì lúc đầu e chỉ gặp rắc rối với 1 curve, vấn đề về 2 curve là ý tưởng phát sinh mà, hìhì...nhưng sao lisp này không kết hợp được với extrim giống như 1 curve hả bác thiep?nếu kết hợp được với extrim thì tuyệt quá bác thiêp a!Thanks bác nhiều nhiều nha

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
Bác Thiếp à,,sory bác vì lúc đầu e chỉ gặp rắc rối với 1 curve, vấn đề về 2 curve là ý tưởng phát sinh mà, hìhì...nhưng sao lisp này không kết hợp được với extrim giống như 1 curve hả bác thiep?nếu kết hợp được với extrim thì tuyệt quá bác thiêp a!Thanks bác nhiều nhiều nha

Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

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
Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

vâng,chúc bác có chuyến công tác vui vẻ và thành công, mong được sự tiếp tục giúp đỡ của bác cũng như của cadviet :s_big:

  • 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
Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

Đi công tác xa chớ có ăn gà rừng là "ngẻo cổ" đó nghe. Chúc pác mnột chuyến công tác ZUI ZẺ

  • 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
Nanhai à, vì ban đầu bạn chỉ yêu cầu xóa các đối tượng trong 1 curve.

Sau đó thì Nanhai yêu cầu thêm xóa các đối tượng ngoài 1 curve.

Bây giờ thì yêu cầu thêm xóa các đối tượng giữa 2 curve, chứ không có "hình như" bạn ạ

...........

Lisp đã chỉnh sửa:

 

ERC.LSP free lisp from cadviet.com

;; copyright by Thiep,06/2009

................................

Chào các bạn.

Về cơ bản thì LISP ERC của bạn Thiệp đã giải quyết đuợc các yêu cầu xóa các đối tuợng trong, ngoài và giữa 2 đuờng bao.

Tuy nhiên với các đối tuợng có giao với đuờng bao thì Lisp ERC chưa hoàn chỉnh.

Để giải quyết vấn đề xóa các đối tuợng có giao với đuờng bao, tui dùng giải pháp là cắt các đối tuợng này tại giao điểm với đuờng bao, sử dụng hàm break_with của CAB trên www.TheSwamp.org

Do hàm break_with chỉ cắt các đối tuợng lines, lwplines, plines, splines, ellipse, circles & arcs nên với các đối tuợng còn lại như Text, Dimension,... LISP không giải quyết triệt để. :s_big:

 

Các bạn chạy thử và cho ý kiến. File

(defun c:EWB (/ ov vl ss1 ss2 ptLst plSet) ;EWB -> Erase With Boundary
 (defun *error* (msg)    
   (if ov (mapcar 'setvar vl ov)) ; reset Sys vars
   (princ (strcat "\n<< Error: " msg " >>")) ; Print Error Message
   (princ) ; Exit Cleanly
   )
 (command "_.undo" "_begin")
 (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
       ov (mapcar 'getvar vl)) ; Get Old values  
 (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

 (initget "T N G")
 (setq	bit (getkword "\nBan muon xoa Trong hay Ngoai duong bao, hay Giua 2 duong bao : " ) )
 (cond
   ((= bit "T") ;xoa Trong duong bao
    (princ"\n<<< Chon duong bao >>> ")
    (if (and (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))
      (setq ssInside (GetssInside ss))
      (> (sslength ssInside) 0))
      (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside))) ) ; xoa ssInside
      )
    )

   ((= bit "G") ;xoa giua 2 duong bao
    (princ"\n<<< Chon duong bao ngoai >>> ")
    (setq ssN (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))
    (princ"\n<<< Chon duong bao trong >>> ")
    (setq ssT (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))
   curT (ssname ssT 0)
   ssT (GetssInside ssT)
   ssN (GetssInside ssN))
    (if (and ssT (> (sslength ssT) 0) ssN (> (sslength ssN) 0) )
      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssT)))
 (if (ssmemb e ssN) (ssdel e ssN)))
      )
    (if (ssmemb curT ssN) (ssdel curT ssN))
    (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssN))) ) ; xoa ss
    )

   ((= bit "N") ;xoa Ngoai duong bao
    (initget "T G")
    (setq bit (getkword "\nXoa Tat ca doi tuong ngoai duong bao, hay chi doi tuong Giao voi duong bao : " ) )
    (princ"\n<<< Chon duong bao >>> ")
    (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))
   cur (ssname ss 0))
    (if (= bit "T")
      (progn ;xoa Tat ca doi tuong ngoai duong bao
 (setq ssInside (GetssInside ss)
       ssAll (ssget "x" (list (cons 410 (getvar "ctab")))) )
 (if (and ssInside (> (sslength ssInside) 0) )
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside)))
     (if (ssmemb e ssAll) (ssdel e ssAll)))
   )
 (if (ssmemb cur ssAll) (ssdel cur ssAll))
 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssAll))) ) ; xoa ss
 )
      ;chi xoa doi tuong Giao voi duong bao
      (if (and (setq ssOutside (GetssOutside ss))
	(> (sslength ssOutside) 0))
 (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssOutside))) ) ; xoa ssOutside
 )
      );if
    );;xoa Ngoai duong bao
   );cond

 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
)

(defun GetssOutside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)  
 (if (and (setq lstss1 (gettouching ss2))
   (setq ss1 (ssadd))
   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)
   )
   (progn ; co ssTouching 
     (break_with ss1 ss2 nil 0)
     (setq cur (ssname ss2 0)
    ssTouching (ssadd)
    ssOutside (ssadd))
     (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))
     ;loc ssTouching -> ssOutside
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))
(if
  (or
    (not(insidep (vlax-curve-getStartPoint e) cur))
    (not(insidep (vlax-curve-getEndPoint e) cur))
    (not(insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2)) cur))
    );or
  (ssadd e ssOutside)
  );if
);foreach
     );progn
   );if
 (if (ssmemb cur ssOutside) (ssdel cur ssOutside))
 ssOutside
 )

(defun GetssInside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching)
 (setq ptLst (GetPtLst (setq cur (ssname ss2 0)))
ssInside (ssget "_WP" ptLst ) )  
 (if (and (setq lstss1 (gettouching ss2))
   (setq ss1 (ssadd))
   (mapcar '(lambda (x) (ssadd x ss1)) lstss1)
   )
   (progn ; co ssTouching
     (break_with ss1 ss2 nil 0)
     (setq ssTouching (ssadd))
     (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2))
     ;loc ssTouching -> ssInside
     (or ssInside (setq ssInside (ssadd)) )
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching)))
(if
  (and (insidep (vlax-curve-getStartPoint e) cur)
       (insidep (vlax-curve-getEndPoint e) cur)
       (insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2))  cur)
       )
  (ssadd e ssInside)
  );if
);foreach
     );progn
   );if
 (if (ssmemb cur ssInside) (ssdel cur ssInside))
 ssInside
 )

(defun GetPtLst (obj / startparam endparam anginc delta div inc pt ptlst)
 (defun ZClosed (lst)
   (if (and (vlax-curve-isClosed obj)
      (not(equal (car lst)(last lst) 1e-6)))
     (append lst (list (car lst)))
     lst))

 (or (eq (type obj) 'VLA-OBJECT)
   (setq obj (vlax-ename->vla-object obj)))
 (setq typ (vlax-get obj 'ObjectName))
 (if (or (eq typ "AcDbCircle") (eq typ "AcDbEllipse"))
   (progn
     (setq param 0)
     (while (< param (* pi 2))
(setq pt (vlax-curve-getPointAtParam obj param)
      ptlst (cons pt ptlst)
      param (+ (/ (* pi 2) 72) param))
)
     (reverse ptlst)
     )
   (progn ;Pline (eq typ "AcDbPolyline")
     (setq param (vlax-curve-getStartParam obj)
    endparam (vlax-curve-getEndParam obj)
    anginc (* pi (/ 7.5 180.0)))
     (setq tparam param)
     (while (<= param endparam)
(setq pt (vlax-curve-getPointAtParam obj param))
(if (not (equal pt (car ptlst) 1e-12))
  (setq ptlst (cons pt ptlst)))
(if  (and (/= param endparam)
	  (setq blg (abs (vlax-invoke obj 'GetBulge param)))
	  (/= 0 blg))
  (progn
    (setq delta (* 4 (atan blg)) ;included angle
	  inc (/ 1.0 (1+ (fix (/ delta anginc))))
                 arcparam (+ param inc))
    (while (< arcparam (1+ param))
      (setq pt (vlax-curve-getPointAtParam obj arcparam)
                   ptlst (cons pt ptlst)
                   arcparam (+ inc arcparam))))
  )
(setq param (1+ param))
)
     (if (and (apply 'and ptlst)
       (> (length ptlst) 1))
(ZClosed (reverse ptlst))
)
     )
   )
 )



;;  Copyright © 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
(defun insidep  (pt Obj / Obj Tol ang doc spc flag int lin xV yV)
 (defun vlax-list->3D-point (lst flag)
 (if lst
   (cons ((if flag car cadr) lst)
         (vlax-list->3D-point (cdddr lst) flag))))
 (or (eq 'VLA-OBJECT (type Obj))
     (setq Obj (vlax-ename->vla-object Obj)))
 (if (not(vlax-curve-getParamAtPoint Obj pt))
   (progn
 (setq Tol  (/ pi 6) ; Uncertainty
       ang  0.0 flag T)
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 (while (and (< ang (* 2 pi)) flag)
   (setq flag (and
                (setq int
                  (vlax-invoke
                    (setq lin
                      (vla-addLine spc
                        (vlax-3D-point pt)
                          (vlax-3D-point
                            (polar pt ang
                              (if (vlax-property-available-p Obj 'length)
                                (vla-get-length Obj) 1.0)))))
                                 'IntersectWith Obj
                                   acExtendThisEntity))
                (<= 6 (length int))
                (setq xV (vl-sort (vlax-list->3D-point int T) '<)
                      yV (vl-sort (vlax-list->3D-point int nil) '<))
                (or (<= (car xV) (car pt) (last xV))
                    (<= (car yV) (cadr pt) (last yV))))
         ang  (+ ang Tol))
   (vla-delete lin))
 flag
 )
   T
   ))


;;; Author: Copyrightゥ 2006-2008 Charles Alan Butler 
;;; Contact @  www.TheSwamp.org
;;===========================================================================
 ;;  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 (sscros / ss lst lstb lstc objl)
   (and
     (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
           objl (mapcar 'vlax-ename->vla-object lstb)
     )
     (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
			 (cons 410 (getvar "ctab"))))
     )
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (setq lst (mapcar 'vlax-ename->vla-object lst))
     (mapcar
       '(lambda (x)
          (mapcar
            '(lambda (y)
               (if (not
                     (vl-catch-all-error-p
                       (vl-catch-all-apply
                         '(lambda ()
                            (vlax-safearray->list
                              (vlax-variant-value
                                (vla-intersectwith y x acextendnone)
                              ))))))
                 (setq lstc (cons (vlax-vla-object->ename x) lstc))
               )
             ) objl)
        ) lst)
   )
   lstc
 )
;;; Author: Copyrightゥ 2006-2008 Charles Alan Butler 
;;; Contact @  www.TheSwamp.org
(defun break_with (ss2brk ss2brkwith self Gap / cmd intpts lst masterlist ss ssobjs
                  onlockedlayer ssget->vla-list list->3pair GetNewEntities oc
                  get_interpts break_obj GetLastEnt LastEntInDatabase ss2brkwithList
                 )
 ;; ss2brk     selection set to break
 ;; ss2brkwith selection set to use as break points
 ;; self       when true will allow an object to break itself
 ;;            note that plined will break at each vertex
 ;;
 ;; return list of enames of new objects  
 (vl-load-com)  
 (princ "\nCalculating Break Points, Please Wait.\n")
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;                S U B   F U N C T I O N S                      
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 ;;  return T if entity is on a locked layer
 (defun onlockedlayer (ename / entlst)
   (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
   (= 4 (logand 4 (cdr (assoc 70 entlst))))
 )

 ;;  return a list of objects from a selection set
;|  (defun ssget->vla-list (ss)
   (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss ))))
 )|;
 (defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7
      (setq i -1)
      (while (setq  ename (ssname ss (setq i (1+ i))))
        (setq allobj (cons (vlax-ename->vla-object ename) allobj))
      )
      allobj
 )

 ;;  return a list of lists grouped by 3 from a flat list
 (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                old (cdddr old)))
   (reverse new)
 )

;;=====================================
;;  return a list of intersect points  
;;=====================================
(defun get_interpts (obj1 obj2 / iplist)
 (if (not (vl-catch-all-error-p
            (setq iplist (vl-catch-all-apply
                           'vlax-safearray->list
                           (list
                             (vlax-variant-value
                               (vla-intersectwith obj1 obj2 acextendnone)
                             ))))))
   iplist
 )
)

;;========================================
;;  Break entity at break points in list  
;;========================================
(defun break_obj (ent brkptlst BrkGap / brkobjlst en enttype maxparam closedobj
                 minparam obj obj2break p1param p2param brkpt2 dlst idx brkptS
                 brkptE brkpt result GapFlg result ignore dist tmppt
                 #ofpts 2gap enddist lastent obj2break stdist
                )
 (or BrkGap (setq BrkGap 0.0)) ; default to 0
 (setq BrkGap (/ BrkGap 2.0)) ; if Gap use 1/2 per side of break point

 (setq obj2break ent
       brkobjlst (list ent)
       enttype   (cdr (assoc 0 (entget ent)))
       GapFlg    (not (zerop BrkGap)) ; gap > 0
       closedobj (vlax-curve-isclosed obj2break)
 )
 ;; when zero gap no need to break at end points
 (if (zerop Brkgap)
   (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 brkptlst
   (progn
 ;;  sort break points based on the distance along the break object
 ;;  get distance to break point, catch error if pt is off end
 ;; ver 2.0 fix - added COND to fix break point is at the end of a
 ;; line which is not a valid break but does no harm
 (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam obj2break
                                              ;; ver 2.0 fix
                                              (cond ((vlax-curve-getparamatpoint obj2break x))
                                                  ((vlax-curve-getparamatpoint obj2break
                                                    (vlax-curve-getclosestpointto obj2break x))))))
                           ) brkptlst))
 ;; sort primary list on distance
 (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2)))))

 (if GapFlg ; gap > 0
   ;; Brkptlst starts as the break point and then a list of pairs of points
   ;;  is creates as the break points
   (progn
     ;;  create a list of list of break points
     ;;  ((idx# stpoint distance)(idx# endpoint distance)...)
     (setq idx 0)
     (foreach brkpt brkptlst

       ;; ----------------------------------------------------------
       ;;  create start break point, then create end break point    
       ;;  ((idx# startpoint distance)(idx# endpoint distance)...)  
       ;; ----------------------------------------------------------
       (setq dist (cadr brkpt)) ; distance to center of gap
       ;;  subtract gap to get start point of break gap
       (cond
         ((and (minusp (setq stDist (- dist BrkGap))) closedobj )
          (setq stdist (+ (vlax-curve-getdistatparam obj2break
                            (vlax-curve-getendparam obj2break)) stDist))
          (setq dlst (cons (list idx
                                 (vlax-curve-getpointatparam obj2break
                                        (vlax-curve-getparamatdist obj2break stDist))
                                 stDist) dlst))
          )
         ((minusp stDist) ; off start of object so get startpoint
          (setq dlst (cons (list idx (vlax-curve-getstartpoint obj2break) 0.0) dlst))
          )
         (t
          (setq dlst (cons (list idx
                                 (vlax-curve-getpointatparam obj2break
                                        (vlax-curve-getparamatdist obj2break stDist))
                                 stDist) dlst))
         )
       )
       ;;  add gap to get end point of break gap
       (cond
         ((and (> (setq stDist (+ dist BrkGap))
                  (setq endDist (vlax-curve-getdistatparam obj2break
                                    (vlax-curve-getendparam obj2break)))) closedobj )
          (setq stdist (- stDist endDist))
          (setq dlst (cons (list idx
                                 (vlax-curve-getpointatparam obj2break
                                        (vlax-curve-getparamatdist obj2break stDist))
                                 stDist) dlst))
          )
         ((> stDist endDist) ; off end of object so get endpoint
          (setq dlst (cons (list idx
                                 (vlax-curve-getpointatparam obj2break
                                       (vlax-curve-getendparam obj2break))
                                 endDist) dlst))
          )
         (t
          (setq dlst (cons (list idx
                                 (vlax-curve-getpointatparam obj2break
                                        (vlax-curve-getparamatdist obj2break stDist))
                                 stDist) dlst))
         )
       )
       ;; -------------------------------------------------------
       (setq idx (1+ IDX))
     ) ; foreach brkpt brkptlst


     (setq dlst (reverse dlst))
     ;;  remove the points of the gap segments that overlap
     (setq idx -1
           2gap (* BrkGap 2)
           #ofPts (length Brkptlst)
     )
     (while (<= (setq idx (1+ idx)) #ofPts)
       (cond
         ((null result) ; 1st time through
          (setq result (list (car dlst)) ; get first start point
                result (cons (nth (1+(* idx 2)) dlst) result))
         )
         ((= idx #ofPts) ; last pass, check for wrap
          (if (and closedobj (> #ofPts 1)
                   (<= (+(- (vlax-curve-getdistatparam obj2break
                           (vlax-curve-getendparam obj2break))
                         (cadr (last BrkPtLst))) (cadar BrkPtLst)) 2Gap))
            (progn
              (if (zerop (rem (length result) 2))
                (setq result (cdr result)) ; remove the last end point
              )
              ;;  ignore previous endpoint and present start point
              (setq result (cons (cadr (reverse result)) result) ; get last end point
                    result (cdr (reverse result))
                    result (reverse (cdr result)))
            )
          )
         )
         ;; Break Gap Overlaps
         ((< (cadr (nth idx Brkptlst)) (+ (cadr (nth (1- idx) Brkptlst)) 2Gap))
          (if (zerop (rem (length result) 2))
            (setq result (cdr result)) ; remove the last end point
          )
          ;;  ignore previous endpoint and present start point
          (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get present end point
          )
         ;; Break Gap does Not Overlap previous point 
         (t
          (setq result (cons (nth (* idx 2) dlst) result)) ; get this start point
          (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get this end point
         )
       ) ; end cond stmt
     ) ; while

     (setq dlst     (reverse result)
           brkptlst nil)
     (while dlst ; grab the points only
       (setq brkptlst (cons (list (cadar dlst)(cadadr dlst)) brkptlst)
             dlst   (cddr dlst))
     )
   )
 )
 ;;   -----------------------------------------------------

 ;; (if (equal  a ent) (princ)) ; debug CAB  -------------

 (foreach brkpt (reverse brkptlst)
   (if GapFlg ; gap > 0
     (setq brkptS (car brkpt)
           brkptE (cadr brkpt))
     (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
                       )
                  )
           )
         )
       )
     )
   )

   (setq closedobj (vlax-curve-isclosed obj2break))
   (if GapFlg ; gap > 0
     (if closedobj
       (progn ; need to break a closed object
         (setq brkpt2 (vlax-curve-getPointAtDist obj2break
                    (- (vlax-curve-getDistAtPoint obj2break brkptE) 0.00001)))
         (command "._break" obj2break "_non" (trans brkpt2 0 1)
                  "_non" (trans brkptE 0 1))
         (and (= "CIRCLE" enttype) (setq enttype "ARC"))
         (setq BrkptE brkpt2)
       )
     )

     (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
                           ;;(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)))
      )
   ) ; endif

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

   (setq LastEnt (GetLastEnt))
   (command "._break" obj2break "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1))
   (and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r"))
   (and (= "CIRCLE" enttype) (setq enttype "ARC"))
   (if (and (not closedobj) ; new object was created
            (not (equal LastEnt (entlast))))
       (setq brkobjlst (cons (entlast) brkobjlst))
   )
 )
 )
 ) ; endif 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
)
;;===================================
;;  CAB - return a list of new enames
(defun GetNewEntities (ename / new)
 (cond
   ((null ename) (alert "Ename nil"))
   ((eq 'ENAME (type ename))
     (while (setq ename (entnext ename))
       (if (entget ename) (setq new (cons ename new)))
     )
   )
   ((alert "Ename wrong type."))
 )
 new
)

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

   (setq LastEntInDatabase (GetLastEnt))
   (if (and ss2brk ss2brkwith)
   (progn
     (setq oc 0
           ss2brkwithList (ssget->vla-list ss2brkwith))
     (if (> (* (sslength ss2brk)(length ss2brkwithList)) 5000)
       (setq *BrkVerbose* t)
     )
     (and *BrkVerbose*
          (princ (strcat "Objects to be Checked: "
           (itoa (* (sslength ss2brk)(length ss2brkwithList))) "\n")))
     ;;  CREATE a list of entity & it's break points
     (foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk
       (if (not (onlockedlayer (vlax-vla-object->ename obj)))
         (progn
           (setq lst nil)
           ;; check for break pts with other objects in ss2brkwith
           (foreach intobj  ss2brkwithList
             (if (and (or self (not (equal obj intobj)))
                      (setq intpts (get_interpts obj intobj))
                 )
               (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
             )
             (and *BrkVerbose* (princ (strcat "Objects Checked: " (itoa (setq oc (1+ oc))) "\r")))
           )
           (if lst
             (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))
           )
         )
       )
     )    
     (and *BrkVerbose* (princ "\nBreaking Objects.\n"))
     (setq *brkcnt* 0) ; break counter
     ;;  masterlist = ((ent brkpts)(ent brkpts)...)
     (if masterlist
       (foreach obj2brk masterlist
         (break_obj (car obj2brk) (cdr obj2brk) Gap)
       )
     )
     )
 )
;;==============================================================
  (and (zerop *brkcnt*) (princ "\nNone to be broken."))
  (setq *BrkVerbose* nil)
 (GetNewEntities LastEntInDatabase) ; return list of enames of new objects
)

  • Vote tăng 6

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

Đăng nhập để thực hiện theo  

×