Đến nội dung


Hình ảnh
- - - - -

(Yêu cầu) Lisp tìm tất cả phần giao của polyline trong 1 polyline khác


  • Please log in to reply
21 replies to this topic

#1 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 27 March 2015 - 08:34 PM

Chào các bạn cadviet thân mến!

Mình biết đề tài mình đưa ra yêu cầu không mới với các bạn, có lẽ nó đã được nêu cụ thể hoặc có liên quan ở đâu đó rối. Nếu có rồi xin các bạn chỉ giúp, nếu chưa có xin các bạn bỏ tý thời gian gúp mình vài gợi ý để có thể xong đc vd này. Trước hết xin cám ơn các bạn.

+ vd mình đưa ra thế này:

- Có một polyline (trước hết xét dạng đơn giản toàn line) hơi phức tạp làm chuẩn (màu đỏ) và một polyline bất kỳ khác (màu xanh), làm thế nào tìm ra tất cả phần giao của pl bất kỳ trong pl làm chuẩn đó. Mục đích để mình tô màu và tính diện tích phần giao bên trong đó một cách tự động. Các bạn nhìn trên hình chính là phần giao ô vuông

http://www.cadviet.c...4/37170_vd1.dwg

 

 


  • 0

#2 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 27 March 2015 - 08:57 PM

Vùa gởi xong mình thấy có đề tài tương tự ở đây (nhưng nó cũng chưa đến hồi kết):

http://www.cadviet.c...duong-polyline/

Thật ra vd này mình đã có vài ý tưởng nhưng nó hơi phức tạp nên muốn xem các bạn có ý tưởng ngắn gọn hơn kg. Mình nghĩ để có thể làm được nên đi theo hướng như vậy:

- Có hàm tính diện tích theo toạ độ (có lẽ đã có)

- Lập danh sách toạ độ các line, điểm giao xem như bắt đầu 1 line khác;

- lượt qua danh sach các line, Bỏ qua các line bên ngoài pl chuẩn.

- Bắt đầu 1 line bên trong pl chuẩn tính điện tích, nếu line nào nằm trên pl bất kỳ thì xoá khỏi danh sách, xét cho đến hết sẽ hoàn thành bài toán.

Có lẽ thế, nhưng mình viết lisp hơi tệ. Mong các bạn có kinh nghiệm viết bằng vl giúp đỡ.

Nếu kg mình cũng sẽ từ từ viết bằng ngôn ngữ líp cũ của mình, có thể sẽ gặp nhiều khó khăn vì mình kg biết các hàm tiên tiến mới của vl


  • 0

#3 tien2005

tien2005

    biết lệnh properties

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

Đã gửi 27 March 2015 - 11:01 PM

bạn tham khảo ở đây, chắc đáp ứng được y/c của bạn

http://www.cadviet.c...iao-nhau/page-2


  • 1

#4 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 28 March 2015 - 12:13 AM

Cám ơn tien2005, mình đã xem lisp đó.

Ý mình muốn tìm ra phân giao bên trong polyline chuẩn và tím ra nó bằng danh sách các point để khi cần có thể tính diện tích hay làm việc gì đó chứ kg cần vẽ nó ra hết. Mình cũng chưa hiểu hết lisp trên chưa thể sửa đổi gì đc theo ý mình.

Mình muốn kq ra kiểu như (list (list 1) (list 2) ...) với list 1 .... là các danh sách các đa giac giao của pl bất kỳ bên trong pl chuẩn


  • 0

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 March 2015 - 09:12 AM

Bác TrungNgaMy sử dụng Lisp này nhé:

(defun c:tgpl(/ e1 e2 Region lst-p lst-tam lst-line)
  (if (setq e1 (car (entsel "\n Chon PLINE 1 :")))
    (if (setq e2 (car (entsel "\n Chon PLINE 2 :")))
      (progn
            (setq Region (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
            )
            (vla-Boolean (car region) 1 (cadr region))
            (setq lst-line (vlax-invoke (vlax-ename->vla-object (entlast)) 'explode))
            (if (/= (cdr(assoc 0 (entget (entlast)))) "LINE")
                                    (setq lst-line (mapcar '(lambda(x) (vlax-invoke x 'explode)) lst-line))
            )
            (setq lst-p nil lst-tam nil)
            (if (null (eq (type (car lst-line)) 'LIST)) (setq lst-line (list lst-line)))
            (foreach x lst-line
              (foreach y x
                (setq lst-tam (append lst-tam (list (vlax-get y 'startpoint)(vlax-get y 'endpoint))))
                (vla-highlight y :vlax-true)
              )
              (setq lst-tam (Tue-list-removetrung lst-tam))
              (setq lst-p (append lst-p (list lst-tam)) lst-tam nil)
            )
     )
     )
   )
  lst-p
)
(defun Tue-list-removetrung (lst / lst1)
  (foreach x lst
      (if (not (member x lst1)) (setq lst1 (append lst1 (list x))))
      (Progn
              (foreach y lst1
                 (if (equal y x 1.0e-8)
                    (setq lst1 (vl-remove y lst1))
                 )
               )
                        (setq lst1 (append lst1 (list x)) )
       )
    )
  lst1
)

  • 1

#6 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 28 March 2015 - 09:57 AM

Tại bạn viết toàn tiếng anh.
  • 0

#7 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 28 March 2015 - 06:17 PM

 

Bác TrungNgaMy sử dụng Lisp này nhé:

(defun c:tgpl(/ e1 e2 Region lst-p lst-tam lst-line)
  (if (setq e1 (car (entsel "\n Chon PLINE 1 :")))
    (if (setq e2 (car (entsel "\n Chon PLINE 2 :")))
      (progn
            (setq Region (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
            )
            (vla-Boolean (car region) 1 (cadr region))
            (setq lst-line (vlax-invoke (vlax-ename->vla-object (entlast)) 'explode))
            (if (/= (cdr(assoc 0 (entget (entlast)))) "LINE")
                                    (setq lst-line (mapcar '(lambda(x) (vlax-invoke x 'explode)) lst-line))
            )
            (setq lst-p nil lst-tam nil)
            (if (null (eq (type (car lst-line)) 'LIST)) (setq lst-line (list lst-line)))
            (foreach x lst-line
              (foreach y x
                (setq lst-tam (append lst-tam (list (vlax-get y 'startpoint)(vlax-get y 'endpoint))))
                (vla-highlight y :vlax-true)
              )
              (setq lst-tam (Tue-list-removetrung lst-tam))
              (setq lst-p (append lst-p (list lst-tam)) lst-tam nil)
            )
     )
     )
   )
  lst-p
)
(defun Tue-list-removetrung (lst / lst1)
  (foreach x lst
      (if (not (member x lst1)) (setq lst1 (append lst1 (list x))))
      (Progn
              (foreach y lst1
                 (if (equal y x 1.0e-8)
                    (setq lst1 (vl-remove y lst1))
                 )
               )
                        (setq lst1 (append lst1 (list x)) )
       )
    )
  lst1
)

Cám ơn Tue_NV.

Đôi lúc mình cứ băn khoăn tại sao cũng biết Lisp mà cứ hay nhờ đến các bạn. Đến khi đọc Lisp các bạn viết rồi thì giải tỏa ngay đc băn khoăn của mình. Các bạn toàn dùng những hàm mới mình chưa từng biết và cũng khá khó hiểu khi đọc nó. Mình đã thử Lisp của bạn trên cả pl toàn line và khi có arc đều đúng. Khi nào rãnh, bạn cho mình hỏi lý:

- cái danh sách tọa độ trả về đúng cho tất cả mọi trường hợp hay chỉ đúng khi pl toàn line

- nếu dùng cái danh sách đó để tính diện tích (bằng công thức tọa độ) thì có đúng kg khi pl có arc ....

- làm thế nào bạn có thể vẽ lại hình dáng của nó khi có cả arc.

** Trường hợp trong pl thứ 2 (pl thứ nhất vẫn làm chuẩn giới hạn) có 1 vài pl nhỏ (kiểu pl có lỗ thủng) thì có giải quyết đc kg bạn

 

@quangnguyen50 : mình đã xem Lisp và tham khảo đường dẫn của bạn chỉ, có lẽ mình se nghiên cứu từ từ vì trên đó chỉ có hàm nên kg thửa ngay đc. Cám ơn bạn


  • 0

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 March 2015 - 10:34 PM

Cám ơn Tue_NV.

Đôi lúc mình cứ băn khoăn tại sao cũng biết Lisp mà cứ hay nhờ đến các bạn. Đến khi đọc Lisp các bạn viết rồi thì giải tỏa ngay đc băn khoăn của mình. Các bạn toàn dùng những hàm mới mình chưa từng biết và cũng khá khó hiểu khi đọc nó. Mình đã thử Lisp của bạn trên cả pl toàn line và khi có arc đều đúng. Khi nào rãnh, bạn cho mình hỏi lý:

- cái danh sách tọa độ trả về đúng cho tất cả mọi trường hợp hay chỉ đúng khi pl toàn line

- nếu dùng cái danh sách đó để tính diện tích (bằng công thức tọa độ) thì có đúng kg khi pl có arc ....

- làm thế nào bạn có thể vẽ lại hình dáng của nó khi có cả arc.

** Trường hợp trong pl thứ 2 (pl thứ nhất vẫn làm chuẩn giới hạn) có 1 vài pl nhỏ (kiểu pl có lỗ thủng) thì có giải quyết đc kg bạn

 

@quangnguyen50 : mình đã xem Lisp và tham khảo đường dẫn của bạn chỉ, có lẽ mình se nghiên cứu từ từ vì trên đó chỉ có hàm nên kg thửa ngay đc. Cám ơn bạn

 

Chào bác TrungNgaMy!

1./ Cái danh sách trả về đúng cho tất cả mọi trường hợp Pline (Pline có ARC, LINE) (điều kiện PLINE phải kín)

2./ Không thể dùng danh sách toạ độ đỉnh đó để tính diện tích cho Pline có ARC được. Code trên Tue_NV viết theo y/c của bác là xuất kết quả ra list các toạ độ.... Muốn tính diện tích thì phải viết kiêru khác (xem code dưới)

3./ Để vẽ lại hình dáng của PLINE khi chứa cả ARC và tính diện tích cho từng PLINE có thể dùng Lisp dưới đây:

Lisp sẽ trả về các Polyline giao và Lisp sẽ highlight lấy các Polyline giao này (Bác có thể lấy danh sách Polyline này để tính diện tích )

 

4./ Bác ví dụ 1 cái về Pline có lỗ thủng nhé!

(defun c:tgpl(/ e1 e2 Region lst-pline lst-line)
  (setvar "cmdecho" 0)
  (if (setq e1 (car (entsel "\n Chon PLINE 1 :")))
    (if (setq e2 (car (entsel "\n Chon PLINE 2 :")))
      (progn
            (setq Region (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
            )
            (vla-Boolean (car region) 1 (cadr region))
            (setq lst-line (vlax-invoke (vlax-ename->vla-object (entlast)) 'explode))
            (if (/= (cdr(assoc 0 (entget (entlast)))) "LINE")
                                    (setq lst-line (mapcar '(lambda(x) (vlax-invoke x 'explode)) lst-line))
            )
            (setq lst-p nil lst-tam nil)
            (if (null (eq (type (car lst-line)) 'LIST)) (setq lst-line (list lst-line)))
            (foreach x lst-line
        (command "._pedit" "m")
            (foreach y x (command (vlax-vla-object->ename y)))
            (command "" "y" "j" "" "")
            (setq lst-pline (append lst-pline (list (entlast))))
           (redraw (entlast) 3)

            )
     )
     )
   )
  lst-pline
)

  • 1

#9 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 28 March 2015 - 11:25 PM

Cám ơn Tue_NV.

Xin lỗi các bạn, lúc đưa vđ mình quên cái này, trường hợp lỗ thủng tuy ít gặp nhưng vẫn có. Mình làm bên địa chính đôi lúc cũng có thửa đất bị thủng như thửa ruộng lớn mà có ao hay vườn nằm lọt thỏm ở giữa vậy.

http://www.cadviet.c...37170_vd1_1.dwg


  • 0

#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 March 2015 - 08:22 AM

Cám ơn Tue_NV.

Xin lỗi các bạn, lúc đưa vđ mình quên cái này, trường hợp lỗ thủng tuy ít gặp nhưng vẫn có. Mình làm bên địa chính đôi lúc cũng có thửa đất bị thủng như thửa ruộng lớn mà có ao hay vườn nằm lọt thỏm ở giữa vậy.

http://www.cadviet.c...37170_vd1_1.dwg

 

Bác dùng Lisp này (áp dụng cho TH có nhiều lỗ thủng)

Lisp hỏi :

- Chọn PLINE 1:

- Chọn PLINE2:

- Quét chọn các lỗ thủng của PLINE1, không chọn lỗ thủng thì Enter

- Quét chọn các lỗ thủng của PLINE2, không chọn lỗ thủng thì Enter

Lisp sẽ highlight các Polyline và sẽ trả về kết quả là ename của PLINE đó, kết quả lưu trong biến lst-pline

(defun c:tgpl(/ e1 e2 ss1 ss2 R1 R2 lst-line lst-pline)
  (setvar "cmdecho" 0)
  (if (setq e1 (car (entsel "\n Chon PLINE 1 :")))
    (if (setq e2 (car (entsel "\n Chon PLINE 2 :")))
      (progn
        (alert "Chon lo thung cua PLINE1. Khong chon thi nhan Enter")
        (setq ss1 (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE"))))
        (alert "Chon lo thung cua PLINE2. Khong chon thi nhan Enter")
        (setq ss2 (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE"))))
    
            (setq R1 (car (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e1)) )))
        (if ss1 (progn
            (mapcar '(lambda(x) (vla-Boolean R1 2 x))
            (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (Tue-ss-list (list ss1 t))) )
            (setq R1 (vlax-ename->vla-object (entlast)))
        ))
        (setq R2 (car (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e2)) )))    
        (if ss2 (progn    
           (mapcar '(lambda(x) (vla-Boolean R2 2 x))
                (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (Tue-ss-list (list ss2 t))) )
            (setq R2 (vlax-ename->vla-object (entlast)))
        ))
            (vla-Boolean R1 1 R2)
            (setq lst-line (vlax-invoke (vlax-ename->vla-object (entlast)) 'explode))
            (if (/= (cdr(assoc 0 (entget (entlast)))) "LINE")
                                    (setq lst-line (mapcar '(lambda(x) (vlax-invoke x 'explode)) lst-line))
            )
            (if (null (eq (type (car lst-line)) 'LIST)) (setq lst-line (list lst-line)))
            (foreach x lst-line
        (command "._pedit" "m")
            (foreach y x (command (vlax-vla-object->ename y)))
            (command "" "y" "j" "" "")
            (setq lst-pline (append lst-pline (list (entlast))))
           (redraw (entlast) 3)

            )
     )
     )
   )
  lst-pline
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
    (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  )
)

  • 1

#11 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 29 March 2015 - 09:14 AM

Công nhận bác Tue_NV làm hay thiệt. Mình đại khái biết lệnh regon có thể tạo các pl từ một đống các line đồng qui. Nhưng làm cách nào mà bác biết đc cái pl mới tạo thành nằm ngoài hay trong cái pl chuẩn vậy. Giả sử mình muốn biết các pl mới tạo nằm ngoài pl chuẩn màu đỏ nhưng nằm trong pl màu xanh thì làm thế nào (kể cả TH có lỗ thủng). Nếu được bác tạo lưu riêng các pl đó vào biến khác giúp.

Cám ơn bác nhiều.

 

(P/s : Lisp kg chạy đc trên cad2010 bác ạ. Mình phải thử trên cad2015, hơi nặng

- Bác cho mình hỏi thêm cái này tý: giả sử mình có 1 pl màu đỏ làm chuẩn và các pl màu xanh bất kỳ khác, làm sao xác định đc từng cái pl màu xanh đó nằm trong, ngoài hay giao với pl màu đỏ)


  • 0

#12 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 March 2015 - 09:36 AM

Công nhận bác Tue_NV làm hay thiệt. Mình đại khái biết lệnh regon có thể tạo các pl từ một đống các line đồng qui. Nhưng làm cách nào mà bác biết đc cái pl mới tạo thành nằm ngoài hay trong cái pl chuẩn vậy. Giả sử mình muốn biết các pl mới tạo nằm ngoài pl chuẩn màu đỏ nhưng nằm trong pl màu xanh thì làm thế nào (kể cả TH có lỗ thủng). Nếu được bác tạo lưu riêng các pl đó vào biến khác giúp.

Cám ơn bác nhiều.

 

(P/s : Lisp kg chạy đc trên cad2010 bác ạ. Mình phải thử trên cad2015, hơi nặng

- Bác cho mình hỏi thêm cái này tý: giả sử mình có 1 pl màu đỏ làm chuẩn và các pl màu xanh bất kỳ khác, làm sao xác định đc từng cái pl màu xanh đó nằm trong, ngoài hay giao với pl màu đỏ)

 

Tue_NV ch­ưa hiểu ý của bác lắm. Bác có thể nói rõ hơn không (2 dòng tô màu xanh)

PL mới tạo thành sẽ nằm trong Pline đỏ và PLine xanh vì nó là "giao" của 2 Pline đỏ và PLine xanh


  • 0

#13 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 29 March 2015 - 11:09 AM

Mình muốn phân biệt 3 trường hợp riêng như trong hình của file gởi kèm. http://www.cadviet.c...4/37170_vd2.dwg

- Trường hợp hỏi thêm mình muốn có 1 hàm lưu 2 biến đầu vào (biến 1 lưu pl màu đỏ - có thể có lỗ thủng, biến 2 là các pl màu xanh bất kỳ) sau đó kiểm tra cho biết mỗi pl màu xanh sẽ nằm trong, ngoài hay giao với pl màu đỏ - kq trả về cũng lưu vào list).

Mình hỏi thêm hơi nhiều, lúc nào bác thấy hứng thú làm giúp.

Cám ơn bác


  • 0

#14 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 March 2015 - 10:23 PM

Mình muốn phân biệt 3 trường hợp riêng như trong hình của file gởi kèm. http://www.cadviet.c...4/37170_vd2.dwg

- Trường hợp hỏi thêm mình muốn có 1 hàm lưu 2 biến đầu vào (biến 1 lưu pl màu đỏ - có thể có lỗ thủng, biến 2 là các pl màu xanh bất kỳ) sau đó kiểm tra cho biết mỗi pl màu xanh sẽ nằm trong, ngoài hay giao với pl màu đỏ - kq trả về cũng lưu vào list).

Mình hỏi thêm hơi nhiều, lúc nào bác thấy hứng thú làm giúp.

Cám ơn bác

 

Bác dùng thử Lisp sau :

Lisp phân biệt 3 TH -> Kết quả:

- Đường màu vàng nằm trong PLINE xanh và ngoài PLINE đỏ

- Đường màu tím giao giữa PLINE xanh và PLINE đỏ

- Đường màu xanh nằm trong PLINE đỏ và ngoài PLINE xanh

(defun c:tgpl(/ e1 e2 ss1 ss2 );lst-line
  (setvar "cmdecho" 0)
  (if (setq e1 (car (entsel "\n Chon PLINE 1 :")))
    (if (setq e2 (car (entsel "\n Chon PLINE 2 :")))
      (progn
        (alert "Chon lo thung cua PLINE1. Khong chon thi nhan Enter")
        (setq ss1 (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE"))))
        (alert "Chon lo thung cua PLINE2. Khong chon thi nhan Enter")
        (setq ss2 (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE"))))
    
            (setq R1 (car (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e1)) )))
        (if ss1 (progn
            (mapcar '(lambda(x) (vla-Boolean R1 2 x))
            (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (Tue-ss-list (list ss1 t))) )
            (setq R1 (vlax-ename->vla-object (entlast)))
        ))
        (setq R2 (car (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (list (vlax-ename->vla-object e2)) )))    
        (if ss2 (progn    
           (mapcar '(lambda(x) (vla-Boolean R2 2 x))
                (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion (Tue-ss-list (list ss2 t))) )
            (setq R2 (vlax-ename->vla-object (entlast)))
        ))
        (vla-Boolean (vla-copy R1) 1 (vla-copy R2))
        (setq lst-R1 (vlax-ename->vla-object (entlast)))
        (vla-Boolean (vla-copy R1) 2 (vla-copy R2))
        (setq lst-R2 (vlax-ename->vla-object (entlast)))
        (vla-Boolean (vla-copy R2) 2 (vla-copy R1))
        (setq lst-R3 (vlax-ename->vla-object (entlast)))
        (setq lst-R1 (trgn lst-R1) lst-R2 (trgn lst-R2) lst-R3 (trgn lst-R3))
        (mapcar '(lambda(x) (vlax-put x 'Color 2) (vla-highlight x :vlax-true)) lst-R2)
        (mapcar '(lambda(x) (vlax-put x 'Color 6) (vla-highlight x :vlax-true)) lst-R1)     
        (mapcar '(lambda(x) (vlax-put x 'Color 4) (vla-highlight x :vlax-true)) lst-R3)
        (mapcar 'vla-erase (list R1 R2))

     )
     )
   )
  (list lst-R1 lst-R2 lst-R3)
)
(defun trgn (lst-R / lst-line)
            (setq lst-line (vlax-invoke lst-R 'explode))
        (if (= (strcase (vlax-get (car lst-line) 'ObjectName)) "ACDBLINE")
           (setq lst-line (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
                                                  'addregion lst-line ))   )
  lst-line
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
    (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  )
)

  • 1

#15 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 30 March 2015 - 12:27 AM

Cám ơn Tue_NV rất nhiều, kg biết nói gì hơn, bác đã làm cả chủ nhật để giúp mình. Có vẻ như bác biết đc mình sẽ muốn gì thêm nên đã làm luôn rồi. Có điều cái biến bác lưu là dạng gì mình chưa dùng nên chưa hiểu, nó kg phải dạng ename thông thường thì phải. Nếu muốn tính diện tích hay hatch một phần từ trong biến đó thì làm thế nào.

Ý mình nói cái này:

 

Command: !lst-r1
(#<VLA-OBJECT IAcadRegion 09e3fd04> #<VLA-OBJECT IAcadRegion 09e3fca4> #<VLA-OBJECT IAcadRegion 09e3fe24> #<VLA-OBJECT IAcadRegion 09e3fdc4>)
 

Mong bác chỉ giúp


  • 0

#16 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 March 2015 - 08:53 AM

Cám ơn Tue_NV rất nhiều, kg biết nói gì hơn, bác đã làm cả chủ nhật để giúp mình. Có vẻ như bác biết đc mình sẽ muốn gì thêm nên đã làm luôn rồi. Có điều cái biến bác lưu là dạng gì mình chưa dùng nên chưa hiểu, nó kg phải dạng ename thông thường thì phải. Nếu muốn tính diện tích hay hatch một phần từ trong biến đó thì làm thế nào.

Ý mình nói cái này:

 

Command: !lst-r1
(#<VLA-OBJECT IAcadRegion 09e3fd04> #<VLA-OBJECT IAcadRegion 09e3fca4> #<VLA-OBJECT IAcadRegion 09e3fe24> #<VLA-OBJECT IAcadRegion 09e3fdc4>)
 

Mong bác chỉ giúp

 

- Để mô tả 1 miền kín ta có thể dùng đối tượng Polyline, Region.

Và để mô tả 1 miền kín có lỗ thủng thì chỉ có thể đối tượng Region

Biến Lst-R1 trả về kết quả của các Region (Có thể có Region lỗ thủng) mô tả dưới dạng Vla-object

Bác có thể chuyển thành kiểu Ename bằng code:

 

(Setq lst-R1 (mapcar '(lambda(x) (vlax-vla-object->ename x)) lst-R1)

tương tự cho Lst-R2, Lst-R3

 

Khi chuyển list Lst-R1 thành ename rồi, bác có thể duyệt qua từng ename  trong Lst-R1 rồi dùng (command.... để có thể Hatch hay tính area cho từng ename

 

Chúc bác thành công nhé!


  • 1

#17 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 30 March 2015 - 09:20 AM

Thành thật cám ơn Tue_NV và tấm lòng anh em Cadviet.

Chúc Cadviet luôn thành công và vững tiến.


  • 1

#18 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 04 April 2015 - 09:51 PM

Chào Tue_NV.

Mình lại có chút việc nhờ đến bác. Khi gặp trường hợp đường pl1 nằm gọn trong pl2 hay ngược lại thì nó báo lỗi như sau:

 

Command: TGPL

 Chon PLINE 1 :
 Chon PLINE 2 :
Select objects:
Select objects:  ; error: AutoCAD.Application: Not applicable
 

Phiền bác chỉnh bổ sung giúp mình và vẫn giữ cái biến trả về có 3 thành phần như cũ, thành phần nào kg có bác cho nó bằng nil giúp vì mình dùng nó cho một số việc khác .

 

Có trường hợp này mình chạy nó báo lỗi,

 

Chon PLINE 1 :
 Chon PLINE 2 :
Select objects:
Select objects:  ; error: AutoCAD.Application: Invalid input
 

bác xem giúp: http://www.cadviet.c...4/37170_vd3.dwg

Cám ơn bác.


  • -1

#19 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 05 April 2015 - 11:52 PM

Đang mày mò tìm cách khắc phục các lỗi trên.

- Về lỗi pl1 nằm trong pl2 hay ngược lại thì đang tạm chữa cháy bằng cách dùng kiểu chọn (ssget "cp" ..) và (ssget "wp" ..) để loại trừ trước khi đưa vào xử lý.

- Còn lỗi 2 (file trên) thì thấy nếu 1 trong các pl đưa vào xử lý mà có ít nhất 2 đỉnh trùng hay chéo nhau tức thì sinh lỗi và CT dừng lại. Mình đang nghĩ cách kiểm tra và bỏ qua TH này. Nếu bác Tue_NV có cách nào xử lý triệt để hơn xin chỉ giúp.

Cám ơn bác


  • 0

#20 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 08 April 2015 - 11:36 AM

Chào bác Tue_NV và các bạn.

Code của bác Tue đang chạy ngon bỗng nhiên báo lỗi khi gặp 1 pl bị trùng đỉnh, tức là có 2 đỉnh trùng vào nhau. Nó 2 trường hợp.

- 1 là đỉnh trùng chung cạnh, TH này mình tìm code xoá đỉnh pl trên CV làm được rồi.

- 2 là TH 2 đỉnh khác cạnh nhau, lúc này pl tạo thành 2 tứ giác. Mình dự tính giải quyết vd này bằng 1 trong 2 cách:

    + 1 là dời 1 trong 2 đỉnh trùng này đi 1 tý (khoảng 0.020m - BV mình đơn vị m), tức cho nó hở ra

    + 2 là cắt cái pl đó thành 2 pl khác nhau.

Tuy nhiên, cả 2 TH này kiến thức của mình chưa đủ để viết (tự tìm ra vị trí trùng và xử lý), mong các bạn hỗ trợ viết giúp hay chỉ dẫn giúp.

Cám ơn các bạn.http://www.cadviet.c...37170_vd6_2.dwg


  • 0