Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
- - - - -

[Yêu Cầu] Lisp Tính Diện Tích (Có Lọc Hình Pick Trùng)


  • Please log in to reply
13 replies to this topic

#1 18011985

18011985

    biết lệnh hatchedit

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

Đã gửi 08 June 2017 - 06:09 PM

Mình đã đọc các lisp pick diện tích trên diễn đàn và các lisp có 1 khuyết điểm không lọc được hình pick trùng.

Các bạn giúp mình lisp pick diện tích sử dụng boundary (region) và có lọc các hình pick trùng.

- Có 3 hình pick diện tích. Sau khi pick 3 hình thì mình pick lại 1 hình nào đó thì mình muốn CAD báo hình đã pick và không tính diện tích hình bị trùng đấy.

Rất mong các bạn giúp đỡ!

 


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2 18011985

18011985

    biết lệnh hatchedit

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

Đã gửi 09 June 2017 - 04:10 PM

Mình viết đoạn code để lọc hình pick trùng nhưng thỉnh thoảng vẫn trả kết quả sai. Mong các bạn góp ý chỉnh sửa

(defun c:ax (/ I a1 FOD KT dtlist tglist k)
  (defun kiemtra (z1 z2 z3 / i itest atest ctest)
    (setq i 0)
    (setq itest (-(length z2)1))
    (while (<= i itest)
      (setq atest (vlax-get z1 'Area))
      (setq ctest (vlax-get z1 'Centroid))
      (if (and (equal atest (nth i z2)0.0001)
      (equal (car ctest) (car (nth i z3))0.0001)
      (equal (cadr ctest) (cadr (nth i z3)))0.0001)
(progn
 (setq k 1)
 (setq i (+ itest 1))
 )
(progn
(setq k 0)
 )
)
      (setq i (+ i 1))
      (Setq atest nil)
      (Setq ctest nil)
      )
    (if (= k 1) (alert "trung roi") (alert "ok"))
      
    );end kiem tra
  (setq i 0)
  (setq k 0)
  (while (setq a1 (getpoint "\n Chon diem:" ))
    (if (eq i 0)
      (progn
(command "-boundary" "a" "o" "r" "" a1 "")
(setq FOD (vlax-ename->vla-object (entlast)))
(setq dtlist (append dtlist (list (vlax-get FOD 'Area))))
(setq tglist (append tglist (list (vlax-get FOD 'Centroid))))
(command "erase" (entlast) "")
);end progn
      (progn
(command "-boundary" "a" "o" "r" "" a1 "")
(setq KT (vlax-ename->vla-object (entlast)))
(kiemtra KT dtlist tglist)
(if (= k 0)
 (progn
   (setq dtlist (append dtlist (list(vlax-get KT 'Area))))
   (setq tglist (append tglist (list(vlax-get KT 'Centroid))))
   )
 )
(command "erase" (entlast) "")
;(setq i (+ i 1))
);end progn
      );end if
    (setq i (+ i 1))
    );end while
  (princ dtlist)
  ); end defun
 
;;;;      

  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#3 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 09 June 2017 - 05:17 PM

Test thử cái này xem (mình mới test sơ sơ):

(defun c:tt  (/ item lst obj pt)
  (while (setq pt (getpoint "\nChon diem:"))
    (vl-cmdf "-boundary" "a" "o" "r" "" pt "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq item (cons (vlax-get obj 'Centroid) (vlax-get obj 'Area)))
    (vla-delete obj)
    (if (member item lst)
      (princ "\ntrung roi...")
      (setq lst (cons item lst))))
  lst)


P/s: Đôi khi vẫn bị, có lẽ phải thêm 1 bước lọc phần tử giống nhau ở list cuối cùng.


Bài viết đã được chỉnh sửa nội dung bởi quocmanh04tt: 09 June 2017 - 07:04 PM

  • 1

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5527 Bài viết
Điểm đánh giá: 2662 (tuyệt vời)

Đã gửi 09 June 2017 - 07:01 PM

Test thử cái này xem (mình mới test sơ sơ):

Diện tích và trọng tâm trùng thì chưa chắc 2 hình trùng nhau QM ạ. Với chủ TP thì không ý kiến nhưng với QM thì phải ý kiến  :D


  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 09 June 2017 - 07:07 PM

Diện tích và trọng tâm trùng thì chưa chắc 2 hình trùng nhau QM ạ. Với chủ TP thì không ý kiến nhưng với QM thì phải ý kiến  :D

Đúng rồi. Vâng cám ơn bác! Em vẫn chưa nghĩ đến trường hợp đó! hehehe :D

 

=> Có khi phải đưa tên đối tượng vào trong item nữa ...???


  • 1

#6 18011985

18011985

    biết lệnh hatchedit

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

Đã gửi 09 June 2017 - 07:11 PM

Cảm ơn các bác chủ TP đang test nhưng chưa thấy ổn nên chưa ý kiến ạ.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#7 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 09 June 2017 - 07:18 PM

Tên đối tượng cũng không được... Bài toán hơi khó! Bác Hạ tư vấn giúp đi bác!

 

P/s: Chủ TP nghiên cứu, 2 hình đồng tâm, cùng diện tích mà không trùng lên khít nhau => nó giao nhau, khi đó pick sẽ khác.

Như vậy có thể áp dụng trùng tâm và diện tích để phân biệt.


  • 0

#8 18011985

18011985

    biết lệnh hatchedit

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

Đã gửi 09 June 2017 - 08:53 PM

Cảm ơn các bài trao đổi của các bác. Các bác test giúp em nhé. Lệnh Vla-delete cad2012 không thực hiện được các bác sửa dùm em.

(defun c:tt  (/ i item lst obj pt)
(vl-load-com)
  (setq i 0)
  (while (setq pt (getpoint "\nChon diem:"))
    (cond ((= i 0)
  (progn
    (vl-cmdf "-boundary" "a" "o" "r" "" pt "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq item (cons (vlax-get obj 'Centroid) (vlax-get obj 'Area)))
    ;(vla-delete obj)
    (setq lst (cons item lst))
    )
  )
 ((/= i 0)
  (progn
    (vl-cmdf "-boundary" "a" "o" "r" "" pt "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq item (cons (vlax-get obj 'Centroid) (vlax-get obj 'Area)))
    (if (/=(member item lst)nil)
      (alert "trung roi...")
      (setq lst (cons item lst)))
    ;(vla-delete obj)
    )
  )
 )
    (setq i (1+ i))
    )
  
  lst)

  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#9 Bee

Bee

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 316 Bài viết
Điểm đánh giá: 103 (tàm tạm)

Đã gửi 09 June 2017 - 09:33 PM

Khả năng là thêm cả length nữa là chắc cú: area trùng, length trùng, centroid trùng thì là trùng pline ^_^


  • 0

#10 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 09 June 2017 - 10:51 PM

 

Cảm ơn các bài trao đổi của các bác. Các bác test giúp em nhé. Lệnh Vla-delete cad2012 không thực hiện được các bác sửa dùm em.

Khoai lạ...! cad2007 vẫn dùng vla-delete được. vla-erase thì sao?


  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5527 Bài viết
Điểm đánh giá: 2662 (tuyệt vời)

Đã gửi 09 June 2017 - 11:07 PM

@Bee: Area+Centroid+Lenght trùng vẫn chưa thể kết luận 2 hình trùng nhau.

@QM: Khi xui xẻo pick phải điểm giao thì sao?

@Tôi: Chịu! 

P/S: đọc lại đầu bài của chủ TP thì phát hiện chúng ta đã đi lạc đường. Ý chủ TP là nếu 1 hình A đã pick để tính Area rồi thì nếu sau đó pick lại hình A sẽ đưa ra thông báo "Hình A đã tính Area rồi, đừng lộn xộn!". Nếu vậy chỉ cần xét Ename hoặc Handle của entity.


Bài viết đã được chỉnh sửa nội dung bởi Doan Van Ha: 09 June 2017 - 11:34 PM

  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 18011985

18011985

    biết lệnh hatchedit

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

Đã gửi 09 June 2017 - 11:38 PM

Lâu ngày không viết lisp nên hơi ngu ý. Bác Doan Van Ha nói đúng ý em rùi. Bác có thể viết đoạn ví dụ khi xét ename hoặc Handle của entity không ạ.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#13 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 10 June 2017 - 06:37 AM

Chủ TP test lại cái này:

 

(defun c:tt  (/ item lst obj pt)

  (while (setq pt (getpoint "\nChon diem:"))
    (vl-cmdf "-BOUNDARY" "A" "O" "R" "" pt "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq item (cons (vla-get-Centroid obj)
                     (rtos (vlax-get obj 'Area) 2 3)))
    (if (member item lst)
      (princ "\nTrung CMN roi...")
      (setq lst (cons item lst)))
    (vla-delete obj))
  ;;(apply '+ (mapcar 'atof (mapcar 'cdr lst)))
  lst)

Tuy nhiên cũng như trước là chưa bẫy lỗi trường hợp không tạo được BOUNDARY (bao gồm cả trường hợp bác Hạ nói "Khi xui xẻo pick phải điểm giao thì sao?" - Trường hợp này cũng không tạo được BOUNDARY)

@Bác Hạ: Em nghĩ vẫn hiểu đúng ý của chủ TP mà.

*** Xét Ename, hay Handle của hình tương đối phức tạp:

- Hướng ban đầu là pick trong vùng, tạo BOUNDARY và lấy diện tích từ BOUNDARY này, bởi vậy mỗi lần pick tạo ra 1 BO nên không so sánh Ename hay Handle được.

- Nếu xét các đối tượng (tạo nên hình A) thì quá phức tạp, gặp trường hợp Hình A được tạo bởi rất nhiều đối tượng khác (ví dụ hình A là 1 đa giác được tạo nên bởi hàng chục cái Line...)

P/s: Hoặc

 

(defun c:tt  (/ item lst obj pt)

  (while (setq pt (getpoint "\nChon diem:"))
    (vl-cmdf "-BOUNDARY" "A" "O" "P" "" pt "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq item (cons (vla-get-Coordinates obj) (rtos (vlax-get obj 'Area) 2 3)))
    (if (member item lst)
      (alert "\nTrung CMN roi Em oi...!")
      (setq lst (cons item lst)))
    (vla-delete obj))
  ;;(apply '+ (mapcar 'atof (mapcar 'cdr lst)))
  lst)

Bài viết đã được chỉnh sửa nội dung bởi quocmanh04tt: 10 June 2017 - 10:21 AM

  • 0

#14 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 17 June 2017 - 02:11 PM

- Góp ý thử cho zui ^^, nếu bạn dùng lsp tính diện tích bằng cách BO còn tùy phương thức xử lý trong lsp, kết quả trả về của lsp như thế nào và cách bạn sử dụng nên có nhiều trường hợp xảy ra

+ lsp còn giữ lại bo đã tạo nằm trên 1 lớp nhất định do lsp tạo ra thì có thể bắt lỗi bằng cách khi pick lần nửa nếu có 2 bo cùng lớp thì "alert", còn bo ngẫu nhiên theo layer hiện hành thì cũng có khả năng lọc nếu còn đang trong quá trình sử dụng lsp pick rùi pick lại, còn sau khi kết thúc lệnh rùi chạy lại pick đúng hình đó nhưng lúc này đã chuyển qua lớp khác hay trường hợp khác lsp bo xong tính xong xóa luôn bo đó thì nhóc cũng chịu ^^.

+ lsp bo xong xuất text diện tích 1 lớp do lsp quy định thì khi pick lại dò trong vùng còn text đó thì "alert", áp dụng đc khi text xuất trưc tiếp trong vùng ko có lựa chọn điểm đặt text, lúc này ko cần quan tâm thằng bo như thế nào, chạy lsp 1 lần hay nhiều lần ^^.

- Tốt nhất bạn cần đưa ra phương thức sử dụng cụ thể, kết quả trả về bạn muốn như thế nào mới có phương án code để lọc vùng diện tích đã tính ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^