Đến nội dung


Hình ảnh
* * * * - 3 Bình chọn

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


  • Please log in to reply
86 replies to this topic

#41 duongthanh85

duongthanh85

    biết vẽ pline

  • Members
  • PipPip
  • 60 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 04 July 2009 - 02:45 AM

Mình nghĩ bạn thử làm như sau:
- Kiểm tra xem đã cài express tools chưa? Mình dùng Acad 2008, khi cài cad mặc định cài luôn.
- Dùng lệnh Btrim
+ Chọn biên.
+ Chọn đối tượng xén bớt.
  • 0
Dương Đình Thành


EDI.com.vn
Mobile : 0903.269.830
duongdinhthanh@edi.com.vn



Thiết kế thi công: Trạm biến áp, đường dây, cáp ngầm, hạ ngầm đường dây, điện tòa nhà, hệ điện thông minh ...

#42 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 04 July 2009 - 11:26 AM

Chào namhai
Với các đối tượng nằm trong và ngoài curve : Lisp làm việc bình thuờng.
Với đối tượng có giao với curve trên mặt bằng nhưng nếu trong không gian chúng không giao nhau (không đồng phẳng) thì Lisp không xử lý đuợc.
Bạn có thể dùng Lisp này để xóa tất cả đối tượng nằm ngoài curve. (không phân biệt có giao trên mặt bằng hay giao trong không gian)

(defun C:EOB (  / en ss lst ssall bbox) ;EOB -> Erasre Out Boudary
(vl-load-com)
(if (and (setq en (car(entsel "\n Chon duong bao : ")))
(wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
(progn
(setq bbox (ACET-ENT-GEOMEXTENTS en))
(setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
(setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
(ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
(command "_.Zoom" "0.95x")
(if (null etrim)(load "extrim.lsp"))
(etrim en (polar
(car bbox)
(angle (car bbox)(cadr bbox))
(* (distance (car bbox)(cadr bbox)) 1.1)))
(if (and
(setq ss (ssget "_CP" lst))
(setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
)
(progn
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach e1 lst (ssdel e1 ssall))
(ACET-SS-ENTDEL ssall)
)
)
)
)
)

Bác Gia Bach à, thanks bác rất nhiều về những lisp của bác nha, quả thật nó rất tuyệt vời,tiện đây cho e hỏi có thể mở rộng lisp eob để xoá các đối tượng nằm trong curve ko nhỉ?
  • 0
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#43 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 05 July 2009 - 01:07 PM

Thank Bác Gia Bach nhiều, lisp CWB chạy quá hay.
  • 0

#44 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 05 July 2009 - 02:18 PM

Sau khi text nhiều lần thì nó bị như thế này, nhờ Bác GiaBach coi lại dùm em là nó bị làm sao.
Đây là file mẫu:
http://www.cadviet.c...Drawing1_10.dwg
( Nhờ Bác ngâm cứu hộ em với )
  • 0

#45 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 05 July 2009 - 02:23 PM

Hix, xin lỗi Bác em tắt máy text lại thì nó lại chạy đúng, chắc cad em bị lỗi gì, mong Bác thông cảm và bỏ qua.
  • 0

#46 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 06 July 2009 - 11:52 AM

Bác GiaBach oi cho em hỏi chút, khi chay lệnh SWB và CWB thì cad báo như thế này thì nó bị làm sao vậy?

Command: ewb Unknown command "EWB". Press F1 for help.

Command: swb _.undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: _m
Command:
Ban muon chon Trong hay Ngoai duong bao, hay Giua 2 duong bao : t
<<< Chon duong bao >>>
Select objects:

Calculating Break Points, Please Wait.

None to be broken.

Command: Specify opposite corner:

MOng nhận được hồi âm của Bác sớm. Do hôm qua em chạy vẫn được mà hôm nay chạy lại thì nó báo như thế. Thank Bác nhiều.
  • 0

#47 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 06 July 2009 - 12:46 PM

.............................
Command: ewb Unknown command "EWB". Press F1 for help.
.........................

Bạn xem lại khi Appload file EWB có báo lỗi gì không?

.........................
Command: swb _.undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: _m
................................

Bạn chạy lại file này : Sellect With Boundary
Chú ý : khi chạy Lisp để màn hình thấy tòan bộ đuờng bao.
  • 1

#48 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 06 July 2009 - 02:17 PM

Bác Gia Bach à, thanks bác rất nhiều về những lisp của bác nha, quả thật nó rất tuyệt vời,tiện đây cho e hỏi có thể mở rộng lisp eob để xoá các đối tượng nằm trong curve ko nhỉ?

Bạn chay thử Lisp này : file
  • 2

#49 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 06 July 2009 - 03:03 PM

Nó cứ báo như vậy không à Bác GiaBach ơi.

Command: SWB
Ban muon chon Trong hay Ngoai duong bao, hay Giua 2 duong bao : t
<<< Chon duong bao >>>
Select objects:

Calculating Break Points, Please Wait.

None to be broken.

Command: *Cancel*

Đây là file cad của em. thank Bác nhiều.
http://www.cadviet.c...Drawing1_14.dwg

( em đã copy code lisp lại 2 lần và chạy thử 3 lần rồi mà kô được )
  • 0

#50 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 06 July 2009 - 03:43 PM

Nó cứ báo như vậy không à Bác GiaBach ơi.

Command: SWB
Ban muon chon Trong hay Ngoai duong bao, hay Giua 2 duong bao : t
<<< Chon duong bao >>>
Select objects:
Calculating Break Points, Please Wait.
None to be broken.
Command: *Cancel*
Đây là file cad của em. thank Bác nhiều.
http://www.cadviet.c...Drawing1_14.dwg

( em đã copy code lisp lại 2 lần và chạy thử 3 lần rồi mà kô được )

lệnh SWB chỉ highlight đối tuợng. sau đó bạn có thể copy, move, .... với tập hợp đã highlight này.
trong file bạn Upload lại sử dụng lệnh CWB : copy đối tuợng ?
lệnh CWP : copy đối tuợng đến vi trí bạn chỉ ra.
  • 2

#51 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 06 July 2009 - 09:08 PM

Hix, để em làm thử lại file khác , cá mơn Bác GiaBach ngiều lắm.
  • 0

#52 xuandao0708

xuandao0708

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 06 July 2009 - 09:40 PM

Thank Bác GiaBach nhiều. Đúng là down nhiều lisp quá nên bị lộn về lệnh. Thank Bác lần nữa.
  • 0

#53 namhai

namhai

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 08 July 2009 - 10:09 AM

Bạn chay thử Lisp này : file

Bác Gia Bach à, cảm ơn bác nhiều vì sự nhiệt tình giúp đỡ của bác!sau này có gì bác lại chỉ giáo cho e với nha!chúc bác sức khoẻ, thành công!!! :s_big:
  • 0
Hãy làm việc hết mình rồi mọi điều tốt đẹp sẽ đến với bạn.....

#54 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 11 August 2009 - 03:46 PM

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 để. :bigsmile:
Các bạn chạy thử và cho ý kiến. File

Gia_Bach, cảm ơn bạn đã hoàn chỉnh erc.lsp thành ewb.lsp thật tuyệt vời. Những ngày vắng mặt, ở nơi không có internet, Thiep cũng đã nghĩ đến hàm break-with và cũng hoàn chỉnh erc.lsp. Bây giờ thì không cần đưa lên diễn đàn nữa. Tuy nhiên EWB vẫn còn thiếu sót khi curve là spline. Còn khi curve là circle, ellipse, bạn tạo listpoint có 72 điểm, mình nghĩ là ít, mình cho đến 2009 điểm (chắc hơi nhiều).
  • 1

#55 Lisp123

Lisp123

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 October 2009 - 12:30 PM

Chào namhai
Với các đối tượng nằm trong và ngoài curve : Lisp làm việc bình thuờng.
Với đối tượng có giao với curve trên mặt bằng nhưng nếu trong không gian chúng không giao nhau (không đồng phẳng) thì Lisp không xử lý đuợc.
Bạn có thể dùng Lisp này để xóa tất cả đối tượng nằm ngoài curve. (không phân biệt có giao trên mặt bằng hay giao trong không gian)

(defun C:EOB (  / en ss lst ssall bbox) ;EOB -> Erasre Out Boudary
(vl-load-com)
(if (and (setq en (car(entsel "\n Chon duong bao : ")))
(wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
(progn
(setq bbox (ACET-ENT-GEOMEXTENTS en))
(setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
(setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
(ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
(command "_.Zoom" "0.95x")
(if (null etrim)(load "extrim.lsp"))
(etrim en (polar
(car bbox)
(angle (car bbox)(cadr bbox))
(* (distance (car bbox)(cadr bbox)) 1.1)))
(if (and
(setq ss (ssget "_CP" lst))
(setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
)
(progn
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach e1 lst (ssdel e1 ssall))
(ACET-SS-ENTDEL ssall)
)
)
)
)
)

Ơ em tưởng cái líp này dùng lệnh extrim thì nó phải extrim được cả Hatch chứ nhỉ? Sao em dùng với hatch mà không được???
  • 0

#56 thanhtranle

thanhtranle

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 15 December 2009 - 03:29 PM

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?

nghe tiêu đề là thấy hãi!
ghê quá! ghé vào xem thử coi thế nào!
  • 0

#57 m.rduong

m.rduong

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 October 2010 - 03:37 PM

Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

;; free lisp from cadviet.com
;;;-------------------------------------------------------------
(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)
)
(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)


Đây là lỗi nó báo thế này :Command: erc
Free lisp from www.cadviet.com
chon duong:
Current length: 4441.7958error: bad argument type
(VLAX-CURVE-GETSTARTPOINT CUR)
mong các bạn sửa giup mình ..Rất cám ơn..
  • 0

#58 Vutuananh174

Vutuananh174

    biết vẽ circle

  • Members
  • PipPip
  • 37 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 23 December 2010 - 11:30 AM

Tại sao không load đưọc file mấy bạn nhỉ?
  • 0

#59 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 23 December 2010 - 12:03 PM

Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

;; free lisp from cadviet.com
;;;-------------------------------------------------------------
(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)
)
(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)


Đây là lỗi nó báo thế này :Command: erc
Free lisp from www.cadviet.com
chon duong:
Current length: 4441.7958error: bad argument type
(VLAX-CURVE-GETSTARTPOINT CUR)
mong các bạn sửa giup mình ..Rất cám ơn..

Hãy thử đưa hàm (vl-load-com) lên đầu coi sao???
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#60 ro88

ro88

    biết vẽ arc

  • Members
  • PipPip
  • 46 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 18 June 2012 - 10:26 PM

cái lisp EOB dùng thì tốt rồi nhưng nếu cut được hatch và block nữa thì quá tuyệt
không biết ban GiaBach co thể bổ sung thêm được không
  • 0