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

Tháng 4 24, 2009

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.com/upfiles/1_13.bmp

Tháng 4 24, 2009

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.com/upfiles/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)
)

Tháng 4 24, 2009

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.com/upfiles/catdtgioihanboidgdo.zip

Tháng 4 24, 2009

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.com/upfiles/catdtgioihanboidgdo.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.

Tháng 4 24, 2009

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.com/upfiles/catdtgioihanboidgdo.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)
)

Tháng 4 24, 2009

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

Tháng 4 25, 2009

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.

Tháng 4 25, 2009

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!

Tháng 4 25, 2009

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.

Tháng 4 25, 2009

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

Tháng 4 25, 2009

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ỉ :(

Tháng 4 25, 2009

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'.

Tháng 4 25, 2009

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?

Tháng 4 26, 2009

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.

Tháng 4 26, 2009

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

Tháng 4 26, 2009

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é.

Tháng 4 27, 2009

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.

Tháng 4 27, 2009

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)
)
;;;-------------------------------------------------------------

Tháng 4 27, 2009

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.com/upfiles/Test_BreakAll.zip

Tháng 4 27, 2009

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.

Tháng 4 27, 2009

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

Tháng 4 27, 2009

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

Tháng 4 27, 2009

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

Tháng 4 27, 2009

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

Tháng 4 28, 2009

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.com/forum/index.php?showtopic=10514

Đăng nhập

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

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

trongquan 3

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

q288 166

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

tdvn 53

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

q288 166

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

q288 166

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

tdvn 53

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

q288 166

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

trongquan 3

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

q288 166

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

q288 166

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

nataca 554

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

Nguyen Hoanh 4.663

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

trongquan 3

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

Phiphi- 176

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

tdvn 53

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

q288 166

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

trongquan 3

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

ssg 1.102

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

Phiphi- 176

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

Phiphi- 176