Chuyển đến nội dung
Diễn đàn CADViet

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

Gửi đến các bạn 1 lisp tính 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ư cao chữ,… Chỉ cần khai báo 1 lần
- Các lệnh tính diện tích bao gồm 4 lệnh riêng biệt như sau:


DT1: pick điểm, bấm đâu tính đó

DT1.gif.0e8980740c70a5ddd2656f4d270f0c36.gif


DT2: pick nhiều điểm, cộng gộp vào nhau (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ẽ)

DT2.gif.7bc8a5799714878d784c014c2aec9add.gif


DT3: chọn đối tượng, 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,…

DT3.gif.288e8af23418a96767972db83a074da5.gif


DT4: như DT3 nhưng là chọn 1 nhóm đối tượng, kết quả là tổng diện tích các đố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ẽ)

DT4.gif.84afc18dbcd2ef285ce343d15c94849f.gif

 

Bonus: kết quả xuất ra có thể là Block do mình định nghĩa (ví dụ Block tem đất), khai báo trong lệnh TL

DT-Block.gif.751fda36f99bff38bb4e9c9b3a85cea9.gif


File lisp: Tinh dien tich hang loat.lsp
Chúc các bạn thành công :)))

  • Like 8
  • Vote tăng 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
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
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

 

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.

 

  • Like 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
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
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ỗ đó :))

image.png.3f432e3a882320f14915f57724eb0f51.png

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

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

 

  • Like 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
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
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
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

  • Like 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
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

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

 

  • Like 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
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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×