Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

[Doan Van Ha 3.191]

Mọi người cho hỏi: có ai gặp lỗi này chưa? Lý do lỗi? Cách giải quyết?

Là: khi lấy Intersection của 2 regions thì kết quả trả về không đúng. VD trong hình và file đính kèm thì khi lấy region to (màu xanh) trừ đi region nhỏ (màu đỏ) cad lại trả về như kết quả Union của 2 regions xanh và đỏ. Đính kèm hình + file cad + file lsp để test.

 

Error.lsp

Intersection.dwg

[gia_bach 1.549]

28 phút trước, Doan Van Ha đã nói:

Mọi người cho hỏi: có ai gặp lỗi này chưa? Lý do lỗi? Cách giải quyết?

Là: khi lấy Intersection của 2 regions thì kết quả trả về không đúng. VD trong hình và file đính kèm thì khi lấy region to (màu xanh) trừ đi region nhỏ (màu đỏ) cad lại trả về như kết quả Union của 2 regions xanh và đỏ. Đính kèm hình + file cad + file lsp để test.

 

 

Error.lsp

Intersection.dwg

Cad 2015 khi dùng (vla-boolean rg_to acIntersection rg_nho) trả về region có area =0

[Doan Van Ha 3.191]

19 phút trước, gia_bach đã nói:

Cad 2015 khi dùng (vla-boolean rg_to acIntersection rg_nho) trả về region có area =0

Nhưng nó có tạo region mới như hình và file không Gia_bach, hay nó vẫn 2 region rời?

[gia_bach 1.549]

6 phút trước, Doan Van Ha đã nói:

Nhưng nó có tạo region mới như hình và file không Gia_bach, hay nó vẫn 2 region rời?

Sau khi chạy lisp của bác, cả hai region đều biến mất.

[Doan Van Ha 3.191]

2 phút trước, gia_bach đã nói:

Sau khi chạy lisp của bác, cả hai region đều biến mất.

Vậy Cad quá rắc rối với các đối tượng kề nhau! Tôi dùng 2007 thì khác, anh dùng 2015 thì khác!

[Doan Van Ha 3.191]

Bạn nào đã viết lisp về tính San Nền cho tui hỏi tí: sau khi đã tính được cao độ và khối lượng các ô lưới, thuật toán để tính khối lượng và vẽ taluy bao quanh công trình như thế nào để chạy nhanh? Lưu ý: nền công trình là 1 pline gồm nhiều cạnh (không chứa arc), lồi lõm tùy vị trí, có cả taluy đào và đắp. Thanks!

[Doan Van Ha 3.191]

Hỏi về thuật toán.

Tôi có 1 pline 2D lớn (màu đỏ), closed, không chứa arc và nhiều pline 2D nhỏ (màu trắng), closed và không chứa arc.

Cần 1  thuật toán để biến các pline nhỏ thỏa mãn:

- Nếu nằm trong đỏ (kể cả trùng cạnh) thì giữ nguyên.

- Nếu nằm ngoài đỏ (kể cả trùng cạnh) thì xóa.

- Nếu giao nhau thì cắt bỏ phần ngoài đỏ và tạo thành pline mới closed (bao gồm cả phần đỏ nằm trong pline trắng như hình).

Đ/k: Không dùng đến region (vì  thứ này đã dùng chạy chậm và dễ lỗi). Và chạy càng nhanh càng tốt (vì có hàng ngàn hình nhỏ).

Ai có thuật toán hay xin mách giùm. Thanks!

 

[Doan Nguyen Van 489]

5 giờ trước, Doan Van Ha đã nói:

Hỏi về thuật toán.

Tôi có 1 pline 2D lớn (màu đỏ), closed, không chứa arc và nhiều pline 2D nhỏ (màu trắng), closed và không chứa arc.

Cần 1  thuật toán để biến các pline nhỏ thỏa mãn:

- Nếu nằm trong đỏ (kể cả trùng cạnh) thì giữ nguyên.

- Nếu nằm ngoài đỏ (kể cả trùng cạnh) thì xóa.

- Nếu giao nhau thì cắt bỏ phần ngoài đỏ và tạo thành pline mới closed (bao gồm cả phần đỏ nằm trong pline trắng như hình).

Đ/k: Không dùng đến region (vì  thứ này đã dùng chạy chậm và dễ lỗi). Và chạy càng nhanh càng tốt (vì có hàng ngàn hình nhỏ).

Ai có thuật toán hay xin mách giùm. Thanks!

 

Hình như bác làm bài toán San nền.

Hầu hết san nền đều làm region. Nếu làm nối kiểu này cháu nghĩ có thể nhưng cũng có khả năng lỗi.

[Doan Van Ha 3.191]

4 phút trước, Doan Nguyen Van đã nói:

Hình như bác làm bài toán San nền.

Hầu hết san nền đều làm region. Nếu làm nối kiểu này cháu nghĩ có thể nhưng cũng có khả năng lỗi.

San nen. Region thì được rồi nhưng chậm và hay lỗi nên mới hỏi CV.

[cuongtk2 341]

bác thử cái này để xem điểm ngoài, trong hay trên pline

check_point_in_pline.LSP

[Doan Nguyen Van 489]

9 phút trước, Doan Van Ha đã nói:

San nen. Region thì được rồi nhưng chậm và hay lỗi nên mới hỏi CV.

Cháu cũng có 1 chương trình san nền riêng. Và cũng dùng region: gợi ý bác đổi mới cách tạo region ( không dùng command ) thì sẽ nhanh hơn 

[Doan Van Ha 3.191]

11 phút trước, Doan Nguyen Van đã nói:

Cháu cũng có 1 chương trình san nền riêng. Và cũng dùng region: gợi ý bác đổi mới cách tạo region ( không dùng command ) thì sẽ nhanh hơn 

Tất nhiên không dùng command rồi

[snowman.hms 59]

Bác theo thuật  toán ở cái link trong này. Tương đối nhanh.

[gia_bach 1.549]

7 giờ trước, Doan Van Ha đã nói:

Hỏi về thuật toán.

Tôi có 1 pline 2D lớn (màu đỏ), closed, không chứa arc và nhiều pline 2D nhỏ (màu trắng), closed và không chứa arc.

Cần 1  thuật toán để biến các pline nhỏ thỏa mãn:

- Nếu nằm trong đỏ (kể cả trùng cạnh) thì giữ nguyên.

- Nếu nằm ngoài đỏ (kể cả trùng cạnh) thì xóa.

- Nếu giao nhau thì cắt bỏ phần ngoài đỏ và tạo thành pline mới closed (bao gồm cả phần đỏ nằm trong pline trắng như hình).

Đ/k: Không dùng đến region (vì  thứ này đã dùng chạy chậm và dễ lỗi). Và chạy càng nhanh càng tốt (vì có hàng ngàn hình nhỏ).

Ai có thuật toán hay xin mách giùm. Thanks!

 

Tôi dùng cách này, (bỏ qua t/h pline khác cao độ.)

Xét giao điểm của 2 pline (có thể dùng hàm IntersectWith ):
-    nếu không có giao điểm (pline màu đỏ và màu vàng) :
      xét 1 đỉnh bất kì của pline (vàng+đỏ), 
         +    nếu đỉnh đó nằm trong pline trắng -> pline đó nằm trong (chọn)
         +    nếu đỉnh đó nằm ngoài -> pline đó nằm ngoài (bỏ)
-    có giao điểm,  duyệt qua toàn bộ các đỉnh của pline
         +    TH1 pline green: nếu tất cả các đỉnh đều nằm ngoài HOẶC nằm trên cạnh của pline trắng -> pline đó nằm ngoài (bỏ)
         +    TH2 pline cyan: nếu tất cả các đỉnh đều nằm trong HOẶC nằm trên cạnh của pline trắng -> pline đó nằm trong (chọn)
         +    TH3 pline magenta: có đỉnh nằm trong và đỉnh nằm ngoài     

 

 

T/hợp 3 (minh họa t/h đơn giản chỉ có 2 giao điểm):

1. BREAK tại các giao điểm , sau đó duyệt qua các đỉnh của pline bị break (có t/hợp phải duyệt qua các trung điểm của các cạnh):
  -    chỉ cần 1 đỉnh nằm ngoài pline trắng -> bỏ qua pline này 
  -    chỉ cần 1 đỉnh nằm trong pline trắng -> chon pline này.

 

2. Làm ngược lại, BREAK pline trắng tại các giao điểm và chọn pline bên trong pline magenta

3. Nối 2 pline với nhau.

 

+ Một t/hợp phức tạp

 

 

[snowman.hms 59]

@gia_bach với 2 pline phức tạp, cách này ko hiệu quả. Vì nó có thể tạo nhiều region khi thực hiện phép giao region. Thuật toán sẽ phải check in_pline nhiều lần.

Nếu là e, e sẽ làm như này

1. Chọn pline đỏ.

2. Ssget "cp"

3. Lọc ss, những thằng ko intersect thì cho vào result

Những thằng intersect thì _dointersection 

Cái dointersection này với tập lớn thì nên build graph với integer index sẽ hiệu quả.

[cuongtk2 341]

SSget "CP" cũng lấy cả pline nằm ngoài có dính 1 điểm trên CP mà bạn. Chắc lại phải xem diện tích nằm trong = 0 thì mới loại được nó. Nhưng mình thấy cách của bạn khá là tốc độ để lọc ra pline nằm ngoài hẳn.

 

[DungNguyen685 40]

Chào mọi người, cho mình hỏi làm thế nào để lấy được danh sách 3 list này vậy nhỉ. 

[naturooo 36]

15 giờ trước, DungNguyen685 đã nói:

Chào mọi người, cho mình hỏi làm thế nào để lấy được danh sách 3 list này vậy nhỉ. 

Tham khảo bài này có code đấy:

https://www.cadviet.com/forum/topic/38641-thêm-1-lisp-in-nhiều-bản-vẽ/?do=findComment&comment=163441

[DungNguyen685 40]

24 phút trước, naturooo đã nói:

Tham khảo bài này có code đấy:

https://www.cadviet.com/forum/topic/38641-thêm-1-lisp-in-nhiều-bản-vẽ/?do=findComment&comment=163441

Cảm ơn bác ạ, để em xem thử.

[anhGeodesy 2]

 

Vào lúc 27/6/2015 tại 16:52, quocmanh04tt đã nói:

Xin lỗi bác, do em đặt câu hỏi chưa rõ ràng. Chính xác hơn Entmake MLEADERSTYLE (chứ không phải là mleader).

Đây là code:

 

• mld.lsp
  
• [✎]
   

(defun c:mld (/ createmultileader shtdata)

 

Nếu như này thì khi vẽ mleader cad sẽ hỏi block tên gì?

 

Dear Bác @quocmanh04tt

Hiện tại em đang cần món này, Vướng cái ContentType như hình dưới đây nhưng chưa biết cách Edit nó. nhờ bác chỉ giáo và Edit .

 

(defun createmultileader (data $stylename / dic obj)

(if (not (member $stylename

(foreach lstnfo (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")

(if (= 3 (car lstnfo))

(if (not newlst)

(setq newlst (list lstnfo))

(setq newlst (append (list lstnfo) newlst)))))))

(if (and (setq dic (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))

(setq dic (cdr (assoc -1 dic)))

(setq obj (entmakex data)))

(progn (dictremove dic $stylename) (dictadd dic $stylename obj))))

(if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vla-put-arrowsymbol $stylename "_Origin2"))))

(not (vl-catch-all-error-p

(vl-catch-all-apply '(lambda () (vla-put-arrowsymbol $stylename acarrowdefault)))))))

(setq shtdata (list (cons 0 "MLEADERSTYLE")

(cons 5 "362")

(cons 102 "{ACAD_REACTORS")

(cons 102 "}")

(cons 100 "AcDbMLeaderStyle")

(cons 179 2)

(cons 170 1)

(cons 171 1)

(cons 172 0)

(cons 90 2)

(cons 40 0.0)

(cons 41 3.14159)

(cons 173 1)

(cons 91 -1056964608)

(cons 92 -2)

(cons 290 1)

(cons 42 2.0)

(cons 291 1)

(cons 43 750.0)

(cons 3 "Standard")

(cons 44 100.0)

(cons 300 "")

(cons 174 5)

(cons 178 5)

(cons 175 1)

(cons 176 0)

(cons 93 -1073741824)

(cons 45 250.0)

(cons 292 0)

(cons 297 0)

(cons 46 4.0)

(cons 94 -1056964608)

(cons 47 0.75)

(cons 49 0.75)

(cons 140 0.75)

(cons 293 1)

(cons 141 0.0)

(cons 294 1)

(cons 177 0)

(cons 142 1.0)

(cons 295 0)

(cons 296 0)

(cons 143 10.0)

(cons 271 0)

(cons 272 9)

(cons 273 9)

(cons 298 1)))

(createmultileader shtdata "SHT")

(princ))

 

 

 

Chỉnh sửa Tháng 8 16, 2021 theo anhGeodesy
Định dạng mã Code

[thanhduan2407 272]

8 giờ trước, anhGeodesy đã nói:

 

 

Dear Bác @quocmanh04tt

Hiện tại em đang cần món này, Vướng cái ContentType như hình dưới đây nhưng chưa biết cách Edit nó. nhờ bác chỉ giáo và Edit .

 

(defun createmultileader (data $stylename / dic obj)

(if (not (member $stylename

(foreach lstnfo (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")

(if (= 3 (car lstnfo))

(if (not newlst)

(setq newlst (list lstnfo))

(setq newlst (append (list lstnfo) newlst)))))))

(if (and (setq dic (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))

(setq dic (cdr (assoc -1 dic)))

(setq obj (entmakex data)))

(progn (dictremove dic $stylename) (dictadd dic $stylename obj))))

(if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vla-put-arrowsymbol $stylename "_Origin2"))))

(not (vl-catch-all-error-p

(vl-catch-all-apply '(lambda () (vla-put-arrowsymbol $stylename acarrowdefault)))))))

(setq shtdata (list (cons 0 "MLEADERSTYLE")

(cons 5 "362")

(cons 102 "{ACAD_REACTORS")

(cons 102 "}")

(cons 100 "AcDbMLeaderStyle")

(cons 179 2)

(cons 170 1)

(cons 171 1)

(cons 172 0)

(cons 90 2)

(cons 40 0.0)

(cons 41 3.14159)

(cons 173 1)

(cons 91 -1056964608)

(cons 92 -2)

(cons 290 1)

(cons 42 2.0)

(cons 291 1)

(cons 43 750.0)

(cons 3 "Standard")

(cons 44 100.0)

(cons 300 "")

(cons 174 5)

(cons 178 5)

(cons 175 1)

(cons 176 0)

(cons 93 -1073741824)

(cons 45 250.0)

(cons 292 0)

(cons 297 0)

(cons 46 4.0)

(cons 94 -1056964608)

(cons 47 0.75)

(cons 49 0.75)

(cons 140 0.75)

(cons 293 1)

(cons 141 0.0)

(cons 294 1)

(cons 177 0)

(cons 142 1.0)

(cons 295 0)

(cons 296 0)

(cons 143 10.0)

(cons 271 0)

(cons 272 9)

(cons 273 9)

(cons 298 1)))

(createmultileader shtdata "SHT")

(princ))

 

 

 

Anh nghiên cứu cái này.

(vla-put-contenttype mlo 2) => số 2 là Mtext, 1 là Block

(cons 170 1) => (cons 170 2)

(defun _makemleaderstyle (name txtstyle / d mld mlo)
  ;; RJP - 09.16.2017
  (if
    (and
      (setq d (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))))
      (= 'vla-object
	 (type (setq mld (vl-catch-all-apply 'vla-item (list d "ACAD_MLEADERSTYLE"))))
      )
      (= 'vla-object
	 (type
	   (setq mlo (vl-catch-all-apply 'vlax-invoke (list mld 'addobject name "AcDbMLeaderStyle")))
	 )
      )
    )
     (progn
       (vla-put-contenttype mlo 2)
       (vla-put-alignspace mlo 0.1)
       (vla-put-annotative mlo :vlax-true)
       (vla-put-arrowsize mlo 0.18)
       (vla-put-blockconnectiontype mlo 0)
       (vla-put-breaksize mlo 0.1)
       (vla-put-description mlo "")
       (vla-put-dogleglength mlo 0.125)
       (vla-put-enablelanding mlo :vlax-true)
       (vla-put-firstsegmentangleconstraint mlo 0)
       (vla-put-landinggap mlo 0.05)
       (vla-put-maxleadersegmentspoints mlo 2)
       (vla-put-scalefactor mlo 1)
       (vla-put-secondsegmentangleconstraint mlo 0)
       (vlax-put mlo 'textalignmenttype 0)
       (vlax-put mlo 'textleftattachmenttype 1)
       (vlax-put mlo 'textrightattachmenttype 1)
       (vla-put-textheight mlo 0.1)
       ;; Make sure you load your texstyle first or it will default to standard
       (vla-put-textstyle
	 mlo
	 (if (tblobjname "style" txtstyle)
	   txtstyle
	   "standard"
	 )
       )
       mlo
     )
  )
)

 

[levietmy 2]

Các bác cho mình hỏi tý.

Mình hay dùng (initget 128) và (getpoint) để vừa nhập text hoặc point sau đó xử lý tình huống gì đó.

Nhưng nhap text nó không cho khoảng trắng (nó xem là enter).

Vậy trong trường hợp này muốn nhập text có khoảng trắng thì làm thế nào.

Cám ơn các bác

[duy782006 1.544]

(setq sl (getstring 5"\nSo luong:"))

-Lưu ý con số 5 này nhé, nếu không có nó thì khi nhập chuổi nút Space sẽ tương đương với enter nghĩa là kết thúc quá trình nhập chuổi, còn có nó thì Space là khoảng trắng.
Tùy theo nhu cầu chuổi cần nhập mà quyết định có số 5 này hay không.

[Doan Van Ha 3.191]

8 phút trước, duy782006 đã nói:

(setq sl (getstring 5"\nSo luong:"))

-Lưu ý con số 5 này nhé, nếu không có nó thì khi nhập chuổi nút Space sẽ tương đương với enter nghĩa là kết thúc quá trình nhập chuổi, còn có nó thì Space là khoảng trắng.
Tùy theo nhu cầu chuổi cần nhập mà quyết định có số 5 này hay không.

initget thì getkword chứ đâu phải getstring mà space được.

[cuongtk2 341]

Ảo quá bác Hà. Em cũng tưởng thật.