Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 20, 2022 Gửi đến các bạn 1 lisp tính chiều dài, diện tích all-in-one, đơn giản, dễ dùng, và có thể tính được theo nhiều yêu cầu đề bài. Cách dùng: - Load lisp, nhập lệnh TL để thiếp lập các thông số như đơn vị, cao chữ,… Chỉ cần khai báo 1 lần (có thể bỏ qua lệnh này) - Các lệnh tính chiều dài, diện tích bao gồm các lệnh riêng biệt như sau: CD1: Tính chiều dài các đối tượng riêng lẻ CD2: Tính TỔNG chiều dài các đối tượng CD3: Tính chiều dài 1 đoạn bất kỳ nằm trên đối tượng DT1: Tính diện tích 1 vùng (pick điểm, bấm đâu tính đó) DT2: Tính TỔNG diện tích các vùng chọn bằng các pick điểm (text kết quả có thể tạo mới bằng cách bấm vào khoảng trắng hoặc sửa text, att bằng cách bấm chọn 1 text, att đã có sẵn trên bản vẽ) DT3: Tính diện tích các đối tượng riêng lẻ, có thể chọn được nhiều đối tượng cùng lúc, nhiều kiểu đối tượng ví dụ: Pline, Spline, Hatch, Region,… DT4: Tính TỔNG diện tích nhiều đối tượng (text kết quả có thể tạo mới bằng cách bấm vào khoảng trắng hoặc sửa text, att bằng cách bấm chọn 1 text, att đã có sẵn trên bản vẽ) Bonus: kết quả xuất ra có thể là Block do người dùng định nghĩa (ví dụ Block tem đất), khai báo trong lệnh TL Một số tính năng khác: - Có thể thay đổi cài đặt mặc định mỗi khi dùng lisp bằng cách sửa trực tiếp file lisp (bằng Notepad hoặc các phần mềm tương tự), chỉ áp dụng với bản "Tinh chieu dai, dien tich v1.01" trở lên File lisp: Tinh dien tich v1.00.lsp (03/03/2023) Tinh dien tich v1.01.lsp (03/04/2023): Thêm option tạo đường bao Tinh chieu dai, dien tich v1.00.lsp (01/11/2023): Thêm tính năng tính chiều dài Tinh chieu dai, dien tich v1.01.lsp (01/02/2024): Người dùng có thể sửa file lisp theo cài đặt mặc định mong muốn + Sửa lỗi lệnh DT2 trên CAD2007 Chúc các bạn thành công :))) 22 5 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
tanbqtb03 9 Báo cáo bài đăng Đã đăng Tháng 12 22, 2022 Cám ơn a 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
doanquanghuy 0 Báo cáo bài đăng Đã đăng Tháng 12 22, 2022 Thank bạn! Mình gặp phải lỗi DT1 too many agruments thì làm sao sửa được ạ? Mình dùng AutoCAD Architecture 2020. 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
7o7 79 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 10 giờ trước, doanquanghuy đã nói: Thank bạn! Mình gặp phải lỗi DT1 too many agruments thì làm sao sửa được ạ? Mình dùng AutoCAD Architecture 2020. Chắc bị lỗi khi HATCH do khác version cad thôi mà, tức là do lỗi dòng (command "-HATCH" "P" "S" pt ""). Có thể CAD architect có lệnh HATCH khác với version cad trước. Bạn thử xem lệnh hatch của bạn có bao nhiêu thông số. 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 1 giờ} trướ}c, 7o7 đã nói: Chắc bị lỗi khi HATCH do khác version cad thôi mà, tức là do lỗi dòng (command "-HATCH" "P" "S" pt ""). Có thể CAD architect có lệnh HATCH khác với version cad trước. Bạn thử xem lệnh hatch của bạn có bao nhiêu thông số. Uh có lẽ vậy, tại mình gà nên chỗ nãy phải dùng command chứ ko làm khác đc :v, nhưng mà command nó cũng có highlight nên khá tiện. Mà giả sử vẫn là dùng command thì bạn có cách nào cải thiện lisp nó thích nghi với các đời cad khác nhau ko ? 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
7o7 79 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 1 giờ trước, Duong Nhat Duy đã nói: Uh có lẽ vậy, tại mình gà nên chỗ nãy phải dùng command chứ ko làm khác đc :v, nhưng mà command nó cũng có highlight nên khá tiện. Mà giả sử vẫn là dùng command thì bạn có cách nào cải thiện lisp nó thích nghi với các đời cad khác nhau ko ? Tôi dùng 2015 thì lisp của bác ok không bị lỗi gì, nhưng câu hỏi của bác phải để người nào cài nhiều cad mới biết mà trả lời, chứ tôi thì không thể. Nói chung viết lisp mà có dòng command thì không thể dùng với mọi loại cad, chỉ có người dùng tự biết mà chỉnh sửa thôi. Hay bác thử dùng (vla-AddHatch (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) acHatchPatternTypePreDefined "ANSI31" :vlax-True)) xem sao. 1 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
NTHAHT 78 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 Mình tham gia 1 cái, tất cả trong 1 lệnh: DTS. (Các lựa chọn nằm ở dòng nhắc) DTS.rar 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 44 phút trước, 7o7 đã nói: Tôi dùng 2015 thì lisp của bác ok không bị lỗi gì, nhưng câu hỏi của bác phải để người nào cài nhiều cad mới biết mà trả lời, chứ tôi thì không thể. Nói chung viết lisp mà có dòng command thì không thể dùng với mọi loại cad, chỉ có người dùng tự biết mà chỉnh sửa thôi. Hay bác thử dùng (vla-AddHatch (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) acHatchPatternTypePreDefined "ANSI31" :vlax-True)) xem sao. Sau khi đọc qua đống code vla để tạo hatch mình nghĩ chắc mình vẫn để command thôi :)) 14 giờ trước, doanquanghuy đã nói: Thank bạn! Mình gặp phải lỗi DT1 too many agruments thì làm sao sửa được ạ? Mình dùng AutoCAD Architecture 2020. Mình chưa hình dung ra lệnh Hatch trong AutoCAD Architecture 2020 nó ntn, bạn thử gõ -HATCH (có dấu trừ nhé) xong chụp màn hình mình xem 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 23, 2022 10 phút trước, NTHAHT đã nói: Mình tham gia 1 cái, tất cả trong 1 lệnh: DTS. (Các lựa chọn nằm ở dòng nhắc) DTS.rar Lisp bạn khá hay, nhưng nó bị ntn, nó ko trừ đi diện tích cục bên trong. Lisp mình tuy ngu ngơ dùng command nhưng đc cái nó lại đỡ đc chỗ đó :)) 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 24, 2022 23 giờ trước, 7o7 đã nói: (vla-AddHatch (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) acHatchPatternTypePreDefined "ANSI31" :vlax-True)) Lệnh này sẽ không chạy được giống như DT1 của bác Duong Nhat Duy. Vì phải có đối tượng để dùng vla-appendouterloop Có thể thay thế lệnh hatch bằng (bpoly point ) tạo ra pline Nếu tạo ra nhiều hơn 1 đối tượng thì tính diện tích pline lớn nhất trừ đi các diện tích nhỏ hơn. (mình không thích lệnh bpoly nhưng đây là sự lựa chọn đơn giản nhất) 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
7o7 79 Báo cáo bài đăng Đã đăng Tháng 12 24, 2022 Vào lúc 23/12/2022 tại 01:41, doanquanghuy đã nói: Thank bạn! Mình gặp phải lỗi DT1 too many agruments thì làm sao sửa được ạ? Mình dùng AutoCAD Architecture 2020. Suy nghĩ kỹ thì thấy dòng báo lỗi "too many agruments" hơi bị vô lý, vì dòng đó chỉ xuất hiện khi hàm (Function) có nhiều thông số hơn so với định nghĩa (defun). Mà trong lisp bác Duy thì hoàn toàn ko có lỗi này. Còn nếu bảo do dòng (command ..) thì cũng ko đúng, vì nếu do command nó sẽ báo lỗi kiểu khác chứ kp "too many agruments". Do đó chắc bác @doanquanghuy có nhầm lẫn gì đó chăng mà không thấy bác ấy đưa hình chụp dòng command lên. Vậy cho nên bác Duy có thể yên tâm là lisp của bác không có lỗi gì hết. Hoặc bác thay lệnh hatch bằng "-Boundary" cũng hay. Lệnh hatch hơi bị khó chịu, và entmake hatch cũng không dễ dàng gì. 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 26, 2022 Vào lúc 24/12/2022 tại 21:54, 7o7 đã nói: Suy nghĩ kỹ thì thấy dòng báo lỗi "too many agruments" hơi bị vô lý, vì dòng đó chỉ xuất hiện khi hàm (Function) có nhiều thông số hơn so với định nghĩa (defun). Mà trong lisp bác Duy thì hoàn toàn ko có lỗi này. Còn nếu bảo do dòng (command ..) thì cũng ko đúng, vì nếu do command nó sẽ báo lỗi kiểu khác chứ kp "too many agruments". Do đó chắc bác @doanquanghuy có nhầm lẫn gì đó chăng mà không thấy bác ấy đưa hình chụp dòng command lên. Vậy cho nên bác Duy có thể yên tâm là lisp của bác không có lỗi gì hết. Hoặc bác thay lệnh hatch bằng "-Boundary" cũng hay. Lệnh hatch hơi bị khó chịu, và entmake hatch cũng không dễ dàng gì. Chắc là mình giữ nguyên lệnh Hatch thôi, vì Bpoly nó có thể ra nhiều đối tượng (pick nhiều điểm cùng 1 lúc), S tổng có thể là tổng hoặc hiệu, chắc phải cần thêm 1 thuật toán phức tạp mới tính nổi S chỗ này nên thôi mình chọn cách đơn giản :)) Nhân tiện mình hỏi sao lệnh này khi kết thúc lại ko tạo ra Hatch nhỉ ? (command "-HATCH" "Properties" "Solid") (while (> (getvar "CMDACTIVE") 0) (command (getpoint)) ) 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
7o7 79 Báo cáo bài đăng Đã đăng Tháng 12 26, 2022 Bác thay (command (getpoint)) bằng (command "pause") thử xem. Bởi vì (getpoint) là hàm chứ kp lệnh. 1 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 26, 2022 7 phút trước, 7o7 đã nói: Bác thay (command (getpoint)) bằng (command "pause") thử xem. Bởi vì (getpoint) là hàm chứ kp lệnh. oke đc r nè, mình cảm ơn nhé ! 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 Pline, Hacth đều tính đc bạn nhé, trong hình minh họa mình cũng đưa vào cho dễ hiểu r ! 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 @Duong Nhat Duy bạn thử dùng hàm này của mình xem sao thay cho hatch. (defun BoundaryAreaPoint ( pt / ent lst area) (setq ent (entlast)) (vl-cmdf "_.boundary" "A" "I" "Y" "O" "P" "X" pt "") (while (setq ent (entnext ent)) (setq lst (cons (vlax-ename->vla-object ent) lst)) ) (setq lst (vl-sort lst '(lambda (a b) (> (vla-get-area a) (vla-get-area b)))) area (abs (apply '- (mapcar 'vla-get-area lst))) ) (cons area lst) ) 1 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
huunhantvxdts 195 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 1 giờ} trướ}c, tannguyen291 đã nói: @Duong Nhat Duy bạn thử dùng hàm này của mình xem sao thay cho hatch. (defun BoundaryAreaPoint ( pt / ent lst area) (setq ent (entlast)) (vl-cmdf "_.boundary" "A" "I" "Y" "O" "P" "X" pt "") (while (setq ent (entnext ent)) (setq lst (cons (vlax-ename->vla-object ent) lst)) ) (setq lst (vl-sort lst '(lambda (a b) (> (vla-get-area a) (vla-get-area b)))) area (abs (apply '- (mapcar 'vla-get-area lst))) ) (cons area lst) ) Nếu Polyline thì khó xét vùng giao nhau? 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 1 phút trước, huunhantvxdts đã nói: Nếu Polyline thì khó xét vùng giao nhau? Boundary mà bạn. làm sao mà giao nhau?? 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
huunhantvxdts 195 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 1 phút trước, tannguyen291 đã nói: Boundary mà bạn. làm sao mà giao nhau?? Nhầm ý mình có người nói Thay Hatch bằng Polyline. mà như trường hợp trên có 2 polyline chồng nhau nên khó làm thôi. 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 13 phút trước, huunhantvxdts đã nói: Nhầm ý mình có người nói Thay Hatch bằng Polyline. mà như trường hợp trên có 2 polyline chồng nhau nên khó làm thôi. mình không hiểu ý bạn. (defun c:testdt1 (/ pt1 sb str) (setq pt1 (getpoint ) sb (BoundaryAreaPoint pt1) str (rtos (car sb) 2 2) ) (mapcar 'vla-delete (cdr sb)) (entmake (list(cons 0 "TEXT")(cons 100 "AcDbEntity")(cons 100 "AcDbText")(cons 1 str)(cons 10 pt1)(cons 40 2)(cons 41 1)(cons 50 0))) (princ) ) bạn thử đoạn test này của mình xem lỗi ở đâu 1 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
huunhantvxdts 195 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 Vừa xong, tannguyen291 đã nói: mình không hiểu ý bạn. (defun c:testdt1 (/ pt1 sb str) (setq pt1 (getpoint ) sb (BoundaryAreaPoint pt1) str (rtos (car sb) 2 2) ) (mapcar 'vla-delete (cdr sb)) (entmake (list(cons 0 "TEXT")(cons 100 "AcDbEntity")(cons 100 "AcDbText")(cons 1 str)(cons 10 pt1)(cons 40 2)(cons 41 1)(cons 50 0))) (princ) ) bạn thử đoạn test này của mình xem lỗi ở đâu cái mày pick điểm nên nó không vấn đề gì cả 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 Ý của bạn là dt4 của bác duy đó hả. cái đó thì còn dễ hơn. dùng vla-addregion xong rồi vla-boolean - acunion lại toàn bộ là xong. không cần dùng đến command luôn. :)) 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 2 giờ trước, tannguyen291 đã nói: @Duong Nhat Duy bạn thử dùng hàm này của mình xem sao thay cho hatch. (defun BoundaryAreaPoint ( pt / ent lst area) (setq ent (entlast)) (vl-cmdf "_.boundary" "A" "I" "Y" "O" "P" "X" pt "") (while (setq ent (entnext ent)) (setq lst (cons (vlax-ename->vla-object ent) lst)) ) (setq lst (vl-sort lst '(lambda (a b) (> (vla-get-area a) (vla-get-area b)))) area (abs (apply '- (mapcar 'vla-get-area lst))) ) (cons area lst) ) Mình mới đọc qua thôi chưa test, mà tóm lại ntn: các lệnh DT3, 4 để tính S đối tượng thì dễ r khỏi bàn; lệnh DT1 thì có thể viết = nhiều cách; nhưng lệnh DT2 chủ ý của mình là pick được nhiều điểm cùng lúc, pick đâu highlight đến đó, như vậy bạn cải tiến nó lên để ko dùng command nữa đc ko, mình cảm ơn ! 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
tannguyen291 128 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 49 phút trước, Duong Nhat Duy đã nói: Mình mới đọc qua thôi chưa test, mà tóm lại ntn: các lệnh DT3, 4 để tính S đối tượng thì dễ r khỏi bàn; lệnh DT1 thì có thể viết = nhiều cách; nhưng lệnh DT2 chủ ý của mình là pick được nhiều điểm cùng lúc, pick đâu highlight đến đó, như vậy bạn cải tiến nó lên để ko dùng command nữa đc ko, mình cảm ơn ! Để tạo ra boundary không dùng command thì mình có 1 hàm như vậy. thuật toán rất dài và chạy cũng k nhanh hơn command boundary. Cảm thấy như là dùng dao mổ trâu để giết con gà vậy. Vì command hatch chạy khá ì ạch nên mọi người cho rằng boundary sẽ nhanh hơn. Hàm phía trên của mình có thể áp dụng cho DT2 của bạn được đấy. (defun c:testdt2 (/ areaall ptx ss1 lst) (setq areaall 0) (while (setq ptx (getpoint)) (setq ss1 (BoundaryAreaPoint ptx) areaall (+ areaall (car ss1)) lst (append lst (cdr ss1) ) ) (mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 3)) (cdr ss1)) ) (setq ptx (getpoint)) (mapcar 'vla-delete lst) (entmake (list(cons 0 "TEXT")(cons 100 "AcDbEntity")(cons 100 "AcDbText") (cons 1 (rtos areaall 2 2))(cons 10 ptx)(cons 40 2)(cons 41 1)(cons 50 0))) (princ) ) 1 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
Duong Nhat Duy 302 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 9 phút trước, tannguyen291 đã nói: Để tạo ra boundary không dùng command thì mình có 1 hàm như vậy. thuật toán rất dài và chạy cũng k nhanh hơn command boundary. Cảm thấy như là dùng dao mổ trâu để giết con gà vậy. Vì command hatch chạy khá ì ạch nên mọi người cho rằng boundary sẽ nhanh hơn. Hàm phía trên của mình có thể áp dụng cho DT2 của bạn được đấy. (defun c:testdt2 (/ areaall ptx ss1 lst) (setq areaall 0) (while (setq ptx (getpoint)) (setq ss1 (BoundaryAreaPoint ptx) areaall (+ areaall (car ss1)) lst (append lst (cdr ss1) ) ) (mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 3)) (cdr ss1)) ) (setq ptx (getpoint)) (mapcar 'vla-delete lst) (entmake (list(cons 0 "TEXT")(cons 100 "AcDbEntity")(cons 100 "AcDbText") (cons 1 (rtos areaall 2 2))(cons 10 ptx)(cons 40 2)(cons 41 1)(cons 50 0))) (princ) ) Hê hê cảm ơn bạn nhé, để mình chỉnh sửa lại lisp cho ngon ngẻ :)) 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