Đế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

#1 trongquan

trongquan

    biết vẽ circle

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

Đã gửi 24 April 2009 - 10:31 AM

Mình chưa giỏi về lisp nên muốn nhờ các cao thủ trong diễn đàn giúp đỡ viết lisp với yêu cầu sau.
Dùng lệnh "ch3" sau đó chỉ vào các đường màu đỏ (là các đường line, pline, spline) là các đường bị chia 3 phần. sau đó chỉ vào các đường 1,2 là các đường biên chia. Thực hiện xong lệnh thì các đường màu đỏ sẽ bị chia làm 3 phần.
LTS: Mình muốn lập lisp này vì nhiều khi muốn tạo nét khuất lại phải ngồi BR các đoạn thẳng bị khuất thành 3 đoạn, sau đó chuyển đoạn ở giữa thành nét đứt. Số lượng nét khuất lại rất nhiều, nếu cứ ngồi BR như thế thì rất lâu.
http://www.cadviet.c...pfiles/1_13.bmp
  • 0

#2 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 24 April 2009 - 11:38 AM

Mình chưa giỏi về lisp nên muốn nhờ các cao thủ trong diễn đàn giúp đỡ viết lisp với yêu cầu sau.
Dùng lệnh "ch3" sau đó chỉ vào các đường màu đỏ (là các đường line, pline, spline) là các đường bị chia 3 phần. sau đó chỉ vào các đường 1,2 là các đường biên chia. Thực hiện xong lệnh thì các đường màu đỏ sẽ bị chia làm 3 phần.
LTS: Mình muốn lập lisp này vì nhiều khi muốn tạo nét khuất lại phải ngồi BR các đoạn thẳng bị khuất thành 3 đoạn, sau đó chuyển đoạn ở giữa thành nét đứt. Số lượng nét khuất lại rất nhiều, nếu cứ ngồi BR như thế thì rất lâu.
http://www.cadviet.c...pfiles/1_13.bmp


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

#3 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 24 April 2009 - 02:55 PM

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

Mình thử với file như vậy thì lisp chạy không đúng
http://www.cadviet.com/upfiles/mau.bmp
file dwg
http://www.cadviet.c...ihanboidgdo.zip
  • 0

#4 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 24 April 2009 - 03:38 PM

Mình thử với file như vậy thì lisp chạy không đúng
http://www.cadviet.com/upfiles/mau.bmp
file dwg
http://www.cadviet.c...ihanboidgdo.zip


bạn muốn làm khó mình rồi, chẳng có cái hình vẽ nàp lại quái dị như thế. Ý bạn là muốn lập 1 cái ct tổng quát cắt vun tất cả các điểm giao nhau chứ gì. Vậy chờ mình suy nghĩ rồi viết tiếp.
  • 0

#5 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 24 April 2009 - 07:24 PM

Mình thử với file như vậy thì lisp chạy không đúng
http://www.cadviet.com/upfiles/mau.bmp
file dwg
http://www.cadviet.c...ihanboidgdo.zip


Mình sửa lại ct như sau, chạy trên file của bạn tdvn thấy ngon lành tuy có hơi lâu một chút vì phải cắt nhiều quá.


(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,ARC,CIRCLE,SPLINE"))))
(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,SPLINE")))
os (getvar "OSMODE"))

(setvar "OSMODE" 0)
(setvar "CMDECHO" 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)
(ssadd (entlast) ss)))
)
(ssdel v ss)
)
(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
)


  • 1

#6 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 24 April 2009 - 07:42 PM

Mình sửa lại ct như sau, chạy trên file của bạn tdvn thấy ngon lành tuy có hơi lâu một chút vì phải cắt nhiều quá.

Cám ơn bạn. CT chạy rất nhanh, chưa đầy 1 giây. Đúng là mình muốn "làm khó" bạn nên đưa ra một trường hợp tổng quát. Vì đây cũng là vấn đề mình đã lập từ thời chưa có vl (trên cad12-14), lúc đó chưa có hàm tìm giao của các đối tượng như bây giờ, mình phải dùng hàm inters, nên chạy rất lâu. Bây gời thì mình rất bận rộn, muốn nghiên cứu các hàm mới của vl nhưng chưa có thời gian, nên tranh thủ học ở các bạn. Có lẽ các kiến thức của mình đã lỗi thời rồi, nên còn phải học ở các bạn nhiều. Một lần nữa cám ơn bạn và cả bạn "trongquan" nữa vì đã đưa ra cái đề tài này
  • 0

#7 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 25 April 2009 - 11:00 AM

Cám ơn bạn. CT chạy rất nhanh, chưa đầy 1 giây. Đúng là mình muốn "làm khó" bạn nên đưa ra một trường hợp tổng quát. Vì đây cũng là vấn đề mình đã lập từ thời chưa có vl (trên cad12-14), lúc đó chưa có hàm tìm giao của các đối tượng như bây giờ, mình phải dùng hàm inters, nên chạy rất lâu. Bây gời thì mình rất bận rộn, muốn nghiên cứu các hàm mới của vl nhưng chưa có thời gian, nên tranh thủ học ở các bạn. Có lẽ các kiến thức của mình đã lỗi thời rồi, nên còn phải học ở các bạn nhiều. Một lần nữa cám ơn bạn và cả bạn "trongquan" nữa vì đã đưa ra cái đề tài này


Bạn tdvn quả là khiêm tốn. Nói chung anh em tham gia diễn đàn đều trên tinh thần học hỏi lẫn nhau và cùng có lợi. Trước khi vào diễn đàn này mình tuy có viết ct nhưng cũng chỉ đủ xài cho công việc của mình, nhưng sau khi vào đây rồi mình cũng học hỏi thêm nhiều cách viết của ng khác vì mỗi ng có 1 sở trường riêng ko ai giống ai. Cung nhờ viết dùm ng khác mà mình phải mày mò tìm hiểu và tự hoàn thiện cách viết ct của mình.
Đối với mình thì mình đặt nặng phần giải thuật hơn là ngôn ngữ, tức là cách giải quyết vấn đề hay bài toán đặt ra. Như cái ct trên chẳng hạn, nếu bạn ko đưa ra cái hình vẽ "quái dị" trên thì mình cũng quên khuấy mất một điều quan trong là khi 1 vật bị cắt thì nó sẽ biến thành 2 vật chứ ko còn là 1 nữa, nếu ko xử lý cái objext mới tạo ra đó thì giải thuật sẽ thiếu sót và kết quả sẽ sai ngay. Vậy coi như chúng ta học hỏi lẫn nhau rồi còn gì.
Chào bạn và chúc bạn thành công.
  • 2

#8 trongquan

trongquan

    biết vẽ circle

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

Đã gửi 25 April 2009 - 03:29 PM

Bạn tdvn quả là khiêm tốn. Nói chung anh em tham gia diễn đàn đều trên tinh thần học hỏi lẫn nhau và cùng có lợi. Trước khi vào diễn đàn này mình tuy có viết ct nhưng cũng chỉ đủ xài cho công việc của mình, nhưng sau khi vào đây rồi mình cũng học hỏi thêm nhiều cách viết của ng khác vì mỗi ng có 1 sở trường riêng ko ai giống ai. Cung nhờ viết dùm ng khác mà mình phải mày mò tìm hiểu và tự hoàn thiện cách viết ct của mình.
Đối với mình thì mình đặt nặng phần giải thuật hơn là ngôn ngữ, tức là cách giải quyết vấn đề hay bài toán đặt ra. Như cái ct trên chẳng hạn, nếu bạn ko đưa ra cái hình vẽ "quái dị" trên thì mình cũng quên khuấy mất một điều quan trong là khi 1 vật bị cắt thì nó sẽ biến thành 2 vật chứ ko còn là 1 nữa, nếu ko xử lý cái objext mới tạo ra đó thì giải thuật sẽ thiếu sót và kết quả sẽ sai ngay. Vậy coi như chúng ta học hỏi lẫn nhau rồi còn gì.
Chào bạn và chúc bạn thành công.

Cảm ơn bạn q288 và bạn tdvn đã trao đổi và bổ sung để lisp hoàn thiện.
Qua sử dụng và tìm hiểu thì mình thấy thuật toán của bạn q288 rất hay, bạn đã giải quyết bài toán tìm giao cắt rất hiệu quả để giải quyết vấn đề một cách rất "thông minh".
Lisp của bạn phải nói là sẽ rất rất cần cho các kỹ sư chúng ta. Lisp của bạn chạy rất nhanh, giúp cho chúng ta tạo nét khuất rất nhanh và hiệu quả, goodbye cái thời ngồi BR các đường của tớ rất là "farmer".
Đề nghị anh Nguyễn Hoành sưu tập lisp này vào thư viện lisp cad của diễn đàn nha.
À bạn q228 này, trong quá trình sử dụng mình nhận thấy nếu các đối tượng của mình là arc hay ellipse là đối tượng bị cắt thì ko được, còn nếu nó là đối tượng biên cắt thì chỉ thằng arc chia được, mặc dù đọc đoạn code của bạn thì tớ thấy bạn có đề cập đến, vậy thì nguyên nhân là do đâu nhỉ?
Chúc bạn sức khoẻ và thành công trong cuộc sống, tình yêu!
  • 0

#9 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 25 April 2009 - 03:53 PM

Cảm ơn bạn q288 và bạn tdvn đã trao đổi và bổ sung để lisp hoàn thiện.
Qua sử dụng và tìm hiểu thì mình thấy thuật toán của bạn q288 rất hay, bạn đã giải quyết bài toán tìm giao cắt rất hiệu quả để giải quyết vấn đề một cách rất "thông minh".
Lisp của bạn phải nói là sẽ rất rất cần cho các kỹ sư chúng ta. Lisp của bạn chạy rất nhanh, giúp cho chúng ta tạo nét khuất rất nhanh và hiệu quả, goodbye cái thời ngồi BR các đường của tớ rất là "farmer".
Đề nghị anh Nguyễn Hoành sưu tập lisp này vào thư viện lisp cad của diễn đàn nha.
À bạn q228 này, trong quá trình sử dụng mình nhận thấy nếu các đối tượng của mình là arc hay ellipse là đối tượng bị cắt thì ko được, còn nếu nó là đối tượng biên cắt thì chỉ thằng arc chia được, mặc dù đọc đoạn code của bạn thì tớ thấy bạn có đề cập đến, vậy thì nguyên nhân là do đâu nhỉ?
Chúc bạn sức khoẻ và thành công trong cuộc sống, tình yêu!


Khi cắt circle, ellípe thì hiện ra dòng sau:
Arc cannot be full 360 degrees
Cannot break a closed, periodic curve at only one point.
vậy thì với object dạng đóng kín như circle, ellipse thì không dùng lệnh break tại một điểm đc. Hiện tại mình chưa nghĩ ra cách đối phó với chuyện này.
  • 0

#10 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 25 April 2009 - 04:54 PM

Còn một điều nữa khi làm việc với đường cong là mình thấy hằng số acExtendBoth trong hàm ints không thích hợp, vì nó có thể cắt ở điểm giao "ảo", tức là điểm extend của đg cong. Mình xin sửa lại là acExtendNone để chỉ cắt ở điểm giao "thực". CT sửa lại như sau:

(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 c:ch3()
(prompt "\nChon vat bi cat:")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE"))))
(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE")))
os (getvar "OSMODE"))

(setvar "OSMODE" 0)
(setvar "CMDECHO" 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)
(ssadd (entlast) ss)))
)
(ssdel v ss)
)
(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
)

  • 2

#11 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 25 April 2009 - 05:25 PM

Bạn tdvn quả là khiêm tốn. Nói chung anh em tham gia diễn đàn đều trên tinh thần học hỏi lẫn nhau và cùng có lợi. Trước khi vào diễn đàn này mình tuy có viết ct nhưng cũng chỉ đủ xài cho công việc của mình, nhưng sau khi vào đây rồi mình cũng học hỏi thêm nhiều cách viết của ng khác vì mỗi ng có 1 sở trường riêng ko ai giống ai. Cung nhờ viết dùm ng khác mà mình phải mày mò tìm hiểu và tự hoàn thiện cách viết ct của mình.

Cái được lớn hơn nữa ở những diễn đàn như thế này là góp phần đưa trình độ chuyên môn của kỹ sư chúng ta lên cao. Mọi người cùng chia sẻ những hiểu biết của mình thì chúng ta càng biết nhiều, càng tiến bộ nhanh. Chẳng mấy chốc mà đuổi kịp thế giới các bác nhỉ :(
  • 0

#12 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 25 April 2009 - 07:37 PM

Cái được lớn hơn nữa ở những diễn đàn như thế này là góp phần đưa trình độ chuyên môn của kỹ sư chúng ta lên cao. Mọi người cùng chia sẻ những hiểu biết của mình thì chúng ta càng biết nhiều, càng tiến bộ nhanh. Chẳng mấy chốc mà đuổi kịp thế giới các bác nhỉ :(

Có vẻ không được hợp chủ đề lắm, nhưng cũng xin được chia sẻ về vấn đề này.

Bây giờ là thời đại toàn cầu hóa, toàn thế giới là 'phẳng', dần dần sẽ tiến đến không còn ranh giới về mặt địa lý. Như vậy, nếu người Việt chúng ta không cùng giúp nhau tiến bộ, không cùng cạnh tranh lành mạnh thúc đẩy nội lực thì sẽ kém xa so với các nước khác. Và dần dần sẽ bị sức ép cạnh tranh của các đối thủ ngoại.

Hiện nay, do yêu cầu về mặt chất lượng chung ở nước ta chưa cao, người Việt dễ xuề xòa với người Việt. Nhưng 5, 10, 20 năm nữa, chúng ta hòa chung về tiêu chuẩn chất lượng với các nước khác trên thế giới, khách hàng Việt sẽ không chấp nhận sản phẩm chất lượng thấp. Nếu chúng ta không cùng giúp nhau nâng cao nội lực ngay từ bây giờ, sẽ xảy ra tình trạng trong nước hàng vẫn thừa, nhưng vẫn phải nhập khẩu hàng có chất lượng tốt từ nước ngoài.

Trong lĩnh vực khác không rõ ra sao, nhưng trong lĩnh vực thiết kế xây dựng, đang có một sự chênh lệnh lớn giữa chất lượng sản phẩm thiết kế nội và ngoại. Sự lý giải là tiền nào của nấy, bọn Tây thiết kế phí nó lớn, nó vẽ kỹ vẽ đẹp. Việt nam mình thiết kế phí còi, vẽ chỉ vậy thôi. Nhưng nếu cứ kéo dài mãi thì liệu khi nhận nhiều tiền như Tây, người Việt mình liệu có vẽ được như Tây không? Dưới góc độ của chủ đầu tư, việc nâng tiền thiết kế phí bằng Tây là chuyện không khó bởi tiền xây dựng công trình thì lớn chứ thiết kế phí đọ với tiền công trình thì không đáng bao nhiêu. Chưa kể bản thiết kế tốt sẽ tiết kiệm bằng mấy lần tiền thiết kế.

Hy vọng trong tương lai gần không còn sự khác biệt giữa 'cầu thủ ngoại' và 'cầu thủ nội' nữa. Và một lúc nào đó trong tương lai xa 'cầu thủ nội' sẽ hơn hẳn 'cầu thủ ngoại'.
  • 2

#13 trongquan

trongquan

    biết vẽ circle

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

Đã gửi 25 April 2009 - 11:47 PM

Còn một điều nữa khi làm việc với đường cong là mình thấy hằng số acExtendBoth trong hàm ints không thích hợp, vì nó có thể cắt ở điểm giao "ảo", tức là điểm extend của đg cong. Mình xin sửa lại là acExtendNone để chỉ cắt ở điểm giao "thực". CT sửa lại như sau:


(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 c:ch3()
(prompt "\nChon vat bi cat:")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE"))))
(prompt "\nChon vat cat:")
(setq ss1 (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE")))
os (getvar "OSMODE"))

(setvar "OSMODE" 0)
(setvar "CMDECHO" 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)
(ssadd (entlast) ss)))
)
(ssdel v ss)
)
(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
)

Đoạn code này của bạn đã khắc phục được khi đối tượng biên cắt là Ellisp thì đã cắt được các đối tượng sau khi bạn đã sửa điểm giao cắt là thực. Hy vọng đoạn code tiếp tục được cải tiến thành các phiên bản mới!
Theo tôi nghĩ chia sẻ trên diễn đàn giúp kiến thức của mình cũng như mọi người càng được nâng cao, là nơi bạn được thể hiện mình, mọi người nhận ra khả năng của bạn ---> tăng mối quan hệ, dẫn tới thành công.
Một đề bài để mọi người thảo luận như một bài toán khiến chúng ta trăn trở giải quyết nhiều khi cũng thật là thú vị, giống như thời đi học khi thầy giáo ra đề toán mà chưa giải được là chúng ta cảm giác bứt rứt, khó ăn khó ngủ phải không?
  • 0

#14 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 26 April 2009 - 09:24 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.
  • 0

#15 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 26 April 2009 - 12:15 PM

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.

Mình cũng nghĩ vậy. Bạn q288 lỡ làm thì làm luôn cho anh em nhé. Bạn thử tăng số đối tượng lên hàng ngàn xem có khả thi không
  • 0

#16 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 26 April 2009 - 03:03 PM

Mình cũng nghĩ vậy. Bạn q288 lỡ làm thì làm luôn cho anh em nhé. Bạn thử tăng số đối tượng lên hàng ngàn xem có khả thi không

Các bạn giao mình "trọng trách" lớn quá, nhưng đã lỡ leo lưng cọp thì cũng phải ráng mà "ôm" lưng cọp. Thật tình lúc đầu mình cũng nghĩ đơn giản từ CT này qua CT kia chỉ cần 1 bước ngắn là đủ, nhưng khi viết mới thấy còn nhiều cái khác nảy sinh ra không thể giải quyết ngay đc. Vả lại chỉ khi rảnh rỗi mình mới viết CT thôi. Vậy cho mình hẹn vài ngày nữa nhé.
  • 3

#17 trongquan

trongquan

    biết vẽ circle

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

Đã gửi 27 April 2009 - 08:22 AM

Các bạn giao mình "trọng trách" lớn quá, nhưng đã lỡ leo lưng cọp thì cũng phải ráng mà "ôm" lưng cọp. Thật tình lúc đầu mình cũng nghĩ đơn giản từ CT này qua CT kia chỉ cần 1 bước ngắn là đủ, nhưng khi viết mới thấy còn nhiều cái khác nảy sinh ra không thể giải quyết ngay đc. Vả lại chỉ khi rảnh rỗi mình mới viết CT thôi. Vậy cho mình hẹn vài ngày nữa nhé.

Chào bạn q288 có một vấn đề nữa đang thử thách khả năng của bạn mà nó phát sinh trong quá trình sử dụng là:
Nếu như tớ cắt các đường có cao độ khác nhau và biên cắt lại ở cao độ bằng 0 chẳng hạn như vậy thì lisp chưa tìm được điểm giao cắt. Vấn đề này phát sinh khi tớ làm việc với các đường đồng mức địa hình, vì vấn đề bảo toàn cao độ mà không thể đưa cao độ đường đồng mức về 0 để cắt được. Trong Cad người ta cũng giải quyết được vấn đề đó như các lệnh TRIM hay EX, BR chẳng hạn, mình vẫn làm việc được trên đường đồng mức có cao độ khác với biên.
Hy vọng bạn sử dụng kiến thức lisp đỉnh cao của bạn giải quyết giúp mình nhé! Cảm ơn bạn.
  • 0

#18 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 27 April 2009 - 05:22 PM

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.

Cắt luôn cả cái "vật cắt" nghĩa là không cần phân biệt, cứ chơi tất! Theo ssg, đừng thêm option cho nó phức tạp ra, bạn thử dùng cái BRA (Break All) sau:

;;;-------------------------------------------------------------
(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 DelSame(L / Ln x) ;;;Delete Same items in List
(foreach x L (if (not (member x Ln)) (setq Ln (append Ln (list x)))))
Ln
)
;;;;-------------------------------------------------------------
(defun int2e (e1 e2 / obj1 obj2 Li a1) ;;;q288's function
(setq
obj1 (vlax-EName->vla-Object e1)
obj2 (vlax-EName->vla-Object e2)
)
(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 intss (ss / L e1 e2 p Lp)
(setq L (ss2ent ss))
(foreach e1 L
(foreach e2 L (if (setq p (int2e e1 e2)) (setq Lp (append Lp p))))
)
(DelSame Lp)
)
;;;-------------------------------------------------------------
(defun C:BRA( / ss p L e)
(vl-load-com)
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE"))))
(foreach p (intss ss)
(setq
ss (ssget "C" p p '((0 . "LINE,LWPOLYLINE,ARC,SPLINE")))
L (ss2ent ss)
)
(foreach e L (command "break" e p p))
)
(princ)
)
;;;-------------------------------------------------------------

  • 2

#19 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 27 April 2009 - 06:26 PM

Cắt luôn cả cái "vật cắt" nghĩa là không cần phân biệt, cứ chơi tất! Theo ssg, đừng thêm option cho nó phức tạp ra, bạn thử dùng cái BRA (Break All) sau:


;;;-------------------------------------------------------------
(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 DelSame(L / Ln x) ;;;Delete Same items in List
(foreach x L (if (not (member x Ln)) (setq Ln (append Ln (list x)))))
Ln
)
;;;;-------------------------------------------------------------
(defun int2e (e1 e2 / obj1 obj2 Li a1) ;;;q288's function
(setq
obj1 (vlax-EName->vla-Object e1)
obj2 (vlax-EName->vla-Object e2)
)
(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 intss (ss / L e1 e2 p Lp)
(setq L (ss2ent ss))
(foreach e1 L
(foreach e2 L (if (setq p (int2e e1 e2)) (setq Lp (append Lp p))))
)
(DelSame Lp)
)
;;;-------------------------------------------------------------
(defun C:BRA( / ss p L e)
(vl-load-com)
(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE"))))
(foreach p (intss ss)
(setq
ss (ssget "C" p p '((0 . "LINE,LWPOLYLINE,ARC,SPLINE")))
L (ss2ent ss)
)
(foreach e L (command "break" e p p))
)
(princ)
)
;;;-------------------------------------------------------------

PP mới thử sơ qua nhưng Lisp trên chưa cắt đúng tại các giao điểm. Nhờ Bác Ssg check dùm với file đính kèm dưới. Thanks.
http://www.cadviet.c...st_BreakAll.zip
  • 1

#20 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

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

Các bạn giao mình "trọng trách" lớn quá, nhưng đã lỡ leo lưng cọp thì cũng phải ráng mà "ôm" lưng cọp. Thật tình lúc đầu mình cũng nghĩ đơn giản từ CT này qua CT kia chỉ cần 1 bước ngắn là đủ, nhưng khi viết mới thấy còn nhiều cái khác nảy sinh ra không thể giải quyết ngay đc. Vả lại chỉ khi rảnh rỗi mình mới viết CT thôi. Vậy cho mình hẹn vài ngày nữa nhé.

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