Đến nội dung


Hình ảnh
- - - - -

list xoá và tự nối line


  • Please log in to reply
4 replies to this topic

#1 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 26 September 2008 - 02:24 PM

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) )
  • 0

#2 0002submin

0002submin

    biết zoom

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

Đã gửi 26 September 2008 - 03:16 PM

Cái lisp này tui dùng cung phải đc hơn 2 năm rui` í, dùng thick phết!
  • 0

#3 cuong49x5

cuong49x5

    biết vẽ pline

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

Đã gửi 30 September 2008 - 11:59 AM

cái lisp này dùng thế nào bác ơi!
  • 0

#4 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 06 October 2008 - 10:00 AM

cái lisp này dùng thế nào bác ơi!

Hình đã gửi
  • 1

#5 caothang

caothang

    biết pan

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

Đã gửi 16 November 2008 - 12:26 AM

ủ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
  • 0