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

list xoá và tự nối line

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

không bit đã up lít này chưa nhỉ, hay phết

;;;************************CUA XOA***************************

(defun cuaxoa (/ g1 g2 ss1 olderr nterr l i temp e1 e2 new old dd dc)

 

(defun nterr (s)

(command "_.UCS" "" "_.UNDO" "E")

(setvar "cmdecho" 1)

(setvar "blipmode" 0)

(setq *error* olderr)

(setq g1 nil g2 nil ss1 nil e1 nil e2 nil olderr nil

nterr nil temp nil i nil l nil new nil old nil dd nil dc nil)

(princ)

)

 

(defun tim_in (dt / p01 p02 ktra)

(setq p01 (cdr (assoc 10 (entget dt))))

(setq p02 (cdr (assoc 11 (entget dt))))

(setq ktra T)

(if (and (> (car p01) (car g1)) (< (car p01) (car g2))

(> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))

(setq ktra nil)

)

(if (and (> (car p02) (car g1)) (< (car p02) (car g2))

(> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))

(setq ktra nil)

)

ktra

)

 

(defun timdt (dt1 dt2 / p01 p02)

(setq p01 (cdr (assoc 10 (entget dt2))))

(setq p02 (cdr (assoc 11 (entget dt2))))

(setvar "ucsicon" 0)

(command "_.UCS" "E" dt1)

(setq p01 (trans p01 0 1))

(setq p02 (trans p02 0 1))

(command "_.UCS" "")

(setvar "ucsicon" 1)

(if (and (equal (cadr p01) 0 0.001) (equal (cadr p02) 0 0.001))

T

nil

)

)

 

(defun tim_out (dt / p01 p02 kt)

(setq p01 (cdr (assoc 10 (entget dt))))

(setq p02 (cdr (assoc 11 (entget dt))))

(if (and (> (car p01) (car g1)) (< (car p01) (car g2))

(> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))

(setq kt p02)

)

(if (and (> (car p02) (car g1)) (< (car p02) (car g2))

(> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))

(setq kt p01)

)

kt

)

 

(setvar "cmdecho" 0)

(setq olderr *error* *error* nterr)

(command "_.UNDO" "G" "_.UCS" "")

(while (null ss1)

(princ "\nChon cua muon xoa...")

(initget 1)

(setq g1 (getpoint "\n>Goc thu nhat:"))

(initget (+ 1 32))

(setq g2 (getcorner g1 "\n>Goc thu hai:"))

(setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))

(if (null ss1) (princ "\nKhong tim thay doi tuong!"))

)

 

(setq temp (list (min (car g1) (car g2)) (min (cadr g1) (cadr g2)))

g2 (list (max (car g1) (car g2)) (max (cadr g1) (cadr g2)))

g1 temp)

(setq ss1 (ssget "w" g1 g2))

(if ss1 (command "_.ERASE" ss1 ""))

(setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))

 

(setvar "blipmode" 0)

(setq i 0 l (sslength ss1))

(while (< i l)

(if (tim_in (ssname ss1 i))

(progn

(ssdel (ssname ss1 i) ss1)

(setq i 0 l (1- l))

)

(setq i (1+ i))

)

)

(setq l (sslength ss1))

(while (>= l 2)

(setq e1 (ssname ss1 0))

(ssdel e1 ss1)

(setq e2 nil i 0 l (sslength ss1))

(while (< i l)

(if (timdt e1 (ssname ss1 i))

(progn

(setq e2 (ssname ss1 i))

(setq dd (tim_out e1))

(setq dc (tim_out e2))

)

)

(setq i (1+ i))

)

(if e2 (progn

(ssdel e2 ss1)

(command "_.ERASE" e2 "")

(setq temp (entget e1))

(setq old (assoc 10 temp))

(setq new (cons 10 dd))

(setq temp (subst new old temp))

(entmod temp)

(setq temp (entget e1))

(setq old (assoc 11 temp))

(setq new (cons 11 dc))

(setq temp (subst new old temp))

(entmod temp)

(redraw e1)

(setq l (sslength ss1))

)

)

)

 

(command "_.UCS" "" "_.UNDO" "E")

(setvar "cmdecho" 1)

(setvar "blipmode" 0)

(setq *error* olderr)

(princ)

 

)

 

(DEFUN C:CX () (CUAXOA) )

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

ủa cái này xài khi nào vậy,

- Xóa line : cx Hình như nó xóa tất cả các đường nằm hoàn toàn trong vùng được chọn

- Tự nối line : không biết xài

 

1 đường thẳng chia làm 2, giờ em muốn nối lại thì dùng làm sao

( em hay kéo dài 1 bên và xóa 1 bên , nhưng lâu quá )

không biết lisp này xài được không , chỉ em với

thankz

 

*******

Em biết xài rồi

cũng là lệnh cx luôn

 

 

thankz

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  

×