Đến nội dung


Hình ảnh
- - - - -

Viết lisp chia đoạn thẳng thành 3 phần


  • Please log in to reply
29 replies to this topic

#21 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 27 April 2009 - 08:37 PM

Thật ra muốn cắt luôn cái "vật cắt" -với Lisp của Q288- thì chỉ cần repeat lại và select all 2 lần là OK liền.


Không đơn giản như bạn nghĩ đâu, lúc đầu mình cũng nghĩ như vậy, nhưng chạy thử thì hoặc có lỗi hoặc cắt không hết. Sau cùng thì phải thay đổi luôn giải thuật, không xài giải thuật cũ nữa. GThuật cũ chỉ thìch hợp với số lg vthể ít thôi, theo như nhu cầu cua bạn trongquan ban đầu là chia 3, nhưng nếu số lg nhiều thì việc quản lý vthể mới sẽ rắc rối lắm, chưa kể hàm ssdel xóa mất đối tượng quá sớm sẽ khiến kết quả sai lạc.
MÌnh cũng đã viết CT mới giải quyết triệt để hơn và gộp luôn option cắt vật cắt như bạn yêu cầu. Còn việc thử trên 1000 vthể mình nghĩ ko cần thiết, đối với file lớn thì nên chia nhỏ ra sẽ tiêt kiệm thời gian hơn. Làm thử phép tính sau:
1000 vthể x 1000 phép toán tìm giao điểm = 1000000 phép toán
giả sử chia nhóm nhỏ 200 vthể và làm 5 lần:
200 vthể x 200 phép tính x 5 lần = 200000 phép toán
Đó là chưa kể đối với máy cấu hình yếu thì dám bị tràn bộ nhớ và treo máy cũng không chừng.

Thao tác CT:
- Đánh lệnh chh
- Chọn vật bị cắt
- Chọn vật cắt, nếu muốn mọi vật đều bị cắt thì [Enter]


(vl-load-com)

(defun ints (o1 o2 / obj1 obj2 li a1)
(setq obj1 (vlax-EName->vla-Object o1)
obj2 (vlax-EName->vla-Object o2)
li nil)
(setq a1 (vlax-Invoke obj1 "IntersectWith" obj2 acExtendNone))
(if a1
(while a1
(setq li (append li (list (list (car a1) (cadr a1) (caddr a1)))))
(repeat 3 (setq a1 (cdr a1)))))
li
)

(defun ss2L(ss / v L)
(setq L nil)
(while (and ss (> (sslength ss) 0))
(setq v (ssname ss 0)
L (cons v L)
ss (ssdel v ss)))
L
)

(defun c:chh()

(defun layd(l1 l2 / n m Li L)
(setq L nil)
(foreach v l1
(setq n 0
m 0)
(repeat (length l2)
(setq Li (ints v (nth m l2))
m (1+ m))
(if Li
(foreach p Li
(if (not (member p L)) (setq L (cons p L)))))
)
(setq n (1+ n))
)
L
)

(prompt "\nChon vat bi cat:")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE")))
Lss (ss2L ss)
os (getvar "OSMODE"))

(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss1 (setq Lss1 (ss2L ss1)))

(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)

(if (not ss1)
(setq L (layd Lss Lss))
(setq L (layd Lss Lss1)))

(foreach p L
(setq ss2 (ssget "c" (polar p (* -0.25 pi) 0.1)
(polar p (* 0.75 pi) 0.1)))
(while (and ss2 (> (sslength ss2) 0))
(setq v (ssname ss2 0))
(if (/= (cdr (assoc 0 (entget v))) "CIRCLE" "ELLIPSE")
(if (not ss1)
(command "break" v p p)
(if (not (member v Lss1)) (command "break" v p p))))
(ssdel v ss2))
)

(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
)

  • 1

#22 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 27 April 2009 - 08:51 PM

Sorry, có chỗ bị sai chút xíu, chép lại code


(vl-load-com)

(defun ints (o1 o2 / obj1 obj2 li a1)
(setq obj1 (vlax-EName->vla-Object o1)
obj2 (vlax-EName->vla-Object o2)
li nil)
(setq a1 (vlax-Invoke obj1 "IntersectWith" obj2 acExtendNone))
(if a1
(while a1
(setq li (append li (list (list (car a1) (cadr a1) (caddr a1)))))
(repeat 3 (setq a1 (cdr a1)))))
li
)

(defun ss2L(ss / v L)
(setq L nil)
(while (and ss (> (sslength ss) 0))
(setq v (ssname ss 0)
L (cons v L)
ss (ssdel v ss)))
L
)

(defun c:chh()

(defun layd(l1 l2 / n m Li L)
(setq L nil)
(foreach v l1
(setq n 0
m 0)
(repeat (length l2)
(setq Li (ints v (nth m l2))
m (1+ m))
(if Li
(foreach p Li
(if (not (member p L)) (setq L (cons p L)))))
)
(setq n (1+ n))
)
L
)

(prompt "\nChon vat bi cat:")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE")))
Lss (ss2L ss)
os (getvar "OSMODE"))

(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss1 (setq Lss1 (ss2L ss1)))

(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)

(if (not ss1)
(setq L (layd Lss Lss))
(setq L (layd Lss Lss1)))

(foreach p L
(setq ss2 (ssget "c" (polar p (* -0.25 pi) 0.1)
(polar p (* 0.75 pi) 0.1)))
(while (and ss2 (> (sslength ss2) 0))
(setq v (ssname ss2 0))
(if (and (/= (cdr (assoc 0 (entget v))) "CIRCLE")
(/= (cdr (assoc 0 (entget v))) "ELLIPSE"))
(if (not ss1)
(command "break" v p p)
(if (not (member v Lss1)) (command "break" v p p))))
(ssdel v ss2))
)

(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
)


  • 1

#23 tdvn

tdvn

    biết lệnh rotate

  • Members
  • PipPipPip
  • 134 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 27 April 2009 - 11:38 PM

Sorry, có chỗ bị sai chút xíu, chép lại code

Nói chung CT chạy tốt. Tuy nhiên, có một vài điểm xem lại :
- CT không cắt các đối tượng ngoài màn hình
- Nếu đối tượng bị cắt là nét đứt và điểm giao nằm ngay khoảng trống thì đối tượng này không bị cắt
- Khi có 3 đối tượng giao nhau tạo thành tam giác với cạnh khá nhỏ thì số điểm bị cắt nhiều hơn số điểm cần thiết
Vài điểm góp ý để bạn hoàn thiện CT
  • 0

#24 hichic

hichic

    Chưa sử dụng CAD

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

Đã gửi 27 April 2009 - 11:49 PM

Bạn dùng lisp này xem sao.


(vl-load-com)

(defun ints (o1 o2 / obj1 obj2 li a1)
(setq obj1 (vlax-EName->vla-Object o1)
obj2 (vlax-EName->vla-Object o2)
li nil)
(setq a1 (vlax-Invoke obj1 "IntersectWith" obj2 acExtendBoth))
(if a1
(while a1
(setq li (append li (list (list (car a1) (cadr a1) (caddr a1)))))
(repeat 3 (setq a1 (cdr a1)))))
li
)

(defun c:ch3()
(prompt "\nChon vat bi cat:")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE"))))
(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,SPLINE")))
os (getvar "OSMODE"))

(setvar "OSMODE" 0)
(while (and ss (> (sslength ss) 0))
(setq v (ssname ss 0)
n 0
L nil)
(repeat (sslength ss1)
(setq v1 (ssname ss1 n)
n (1+ n)
L (ints v v1))
(if L
(foreach p L (command "break" v p p)))
)
(ssdel v ss)
)
(setvar "OSMODE" os)
)


  • 0

#25 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 28 April 2009 - 10:47 AM

Chào các Bác,
Với Lisp trên, nhờ các Bác có thể bổ sung option để cho phép cắt luôn cả cái "vật cắt" luôn nhé. Xin cảm ơn.


........
Bạn thử tăng số đối tượng lên hàng ngàn xem có khả thi không

Chào các bạn.
Mời bạn tham khảo bài viết này http://www.cadviet.c...showtopic=10514
  • 1

#26 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 28 April 2009 - 06:46 PM

Chào các bạn.
Mời bạn tham khảo bài viết này http://www.cadviet.c...showtopic=10514


CT của bạn gia_bach sưu tầm rất hay, giải quyết rốt ráo mọi thứ. Phải công nhận tụi Tây viết có bài bản hơn mình, mình còn phải học nhiều.
Nói thật mình đọc mà chẵng hiểu, nó xài nhiều hảm mới quá. Thôi ráng đọc help để hiểu vậy.
  • 1

#27 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 28 April 2009 - 07:06 PM

CT của bạn gia_bach sưu tầm rất hay, giải quyết rốt ráo mọi thứ. Phải công nhận tụi Tây viết có bài bản hơn mình, mình còn phải học nhiều.
Nói thật mình đọc mà chẵng hiểu, nó xài nhiều hảm mới quá. Thôi ráng đọc help để hiểu vậy.

Các hàm visual lisp ra đời từ cad2000. Đến này gần chục năm rùi. Các hàm trên đâu còn là mới. Có chăng là trách mấy ông dịch sách chẳng hiểu mô tê j mà cũng dịch. Đọc còn thấy khó hiểu hơn bản nguyên gốc tiếng Anh. ( hồi xưa mình hí hửng mua được quyển hướng dẫn visual lisp 2006 ai dè về xem lại gần giống hệt quyển visual lisp 2000 của ông bạn mình :( . Đúng là hết chỗ nói). Bây giờ muốn học thì phải chịu khó đọc help. Không biết thì tra từ điển. Khoảng 1 tháng là đọc ngon ơ ngay. Tham gia một số diễn đàn Cad, lisp của thế giới cũng là một cách hay.
  • 0

#28 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 26 November 2016 - 02:53 PM

https://drive.google...RHlaRThsNmc5YU0

đây là lisp e down về dùng (không nhớ ở # mấy nữa ạ) e nhờ mọi người sửa lại lisp giúp e là lisp chỉ cắt những vật bị cắt khi vật cắt giao với vật bị cắt ạ. tức là đường màu xám chỉ bị cắt tại những vị trí đang giao với đường màu tím, các đường màu tím nào mà ko giao thì sẽ ko cắt ạ. e cảm ơn

https://drive.google...ZGNoaGNjRW0zcGs


  • 0

#29 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 26 November 2016 - 03:57 PM

Trong lisp bạn tìm cái này acExtendBoth thay bằng acExtendNone.


  • 1

#30 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 26 November 2016 - 05:07 PM

Trong lisp bạn tìm cái này acExtendBoth thay bằng acExtendNone.

ngon lành rồi anh ạ, đỡ công quá, hj2. cảm ơn a nha


  • 0