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

Viết lisp theo yêu cầu [phần 2]

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

(defun c:TDT ()

(vl-load-com)

(setq cmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(prompt "\nchon cac vung can tinh:")

(setq TH (ssget))

(setq SPT (sslength TH))

(setq TOCD 0 DEM 0 chu1a "")

(while (< DEM SPT)

(setq PT (ssname TH DEM)

CDPT (vlax-curve-getarea pt)

dsdinh (acet-geom-vertex-list pt)

TOCD (+ TOCD CDPT)

DEM (1+ DEM)

chu1a (strcat chu1a " + " (rtos cdpt 2 1))

)

(command "text" (car dsdinh) "5" "0" (rtos cdpt 2 1))

)

(setvar "cmdecho" cmd)

(Princ chu1a)

(princ (strcat "\nTong dien tich " (itoa dem) " vung la (m2):" (rtos tocd 2 1) " m2."))

(princ)

)

 

=====

Bạn cần lưu ý.

Đặt biến DIMLFAX là 100,đơn vị diện tích là m2

Diện tích mỗi vùng có ghi bằng text tại vùng đó

Cũng có thể diện tích sẽ trừ đi vì có các đảo trong lòng hồ.

Trong hình vẽ có 1 Spline Bạn xóa Pline đó đi vì vùng diện tích đã bao Spline đó rồi (thừa)

Bạn nên kiểm tra lại kết quả vì có 1 số hình kỳ dị...

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
(defun c:TDT ()

(vl-load-com)

(setq cmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(prompt "\nchon cac vung can tinh:")

(setq TH (ssget))

(setq SPT (sslength TH))

(setq TOCD 0 DEM 0 chu1a "")

(while (< DEM SPT)

(setq PT (ssname TH DEM)

CDPT (vlax-curve-getarea pt)

dsdinh (acet-geom-vertex-list pt)

TOCD (+ TOCD CDPT)

DEM (1+ DEM)

chu1a (strcat chu1a " + " (rtos cdpt 2 1))

)

(command "text" (car dsdinh) "0" (rtos cdpt 2 1))

)

(setvar "cmdecho" cmd)

(Princ chu1a)

(princ (strcat "\nTong dien tich " (itoa dem) " vung la (m2):" (rtos tocd 2 1) " m2."))

(princ)

)

 

=====

Bạn cần lưu ý.

Đặt biến DIMLFAX là 100,đơn vị diện tích là m2

Diện tích mỗi vùng có ghi bằng text tại vùng đó

Cũng có thể diện tích sẽ trừ đi vì có các đảo trong lòng hồ.

ko đc bác ah.nó báo lỗi . Bác xem lại cho em vớ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
ko đc bác ah.nó báo lỗi . Bác xem lại cho em với

Bạn load lại bài viết trên nhé (đã sửa rồi).Báo lỗi vì chưa định chiều cao trong lệnh text.

Nếu vẫn báo lỗi thì Bạn up lỗi đó lên xem sao.

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
Bạn load lại bài viết trên nhé (đã sửa rồi).Báo lỗi vì chưa định chiều cao trong lệnh text.

Nếu vẫn báo lỗi thì Bạn up lỗi đó lên xem sao.

Cám ơn Bác nhiều. Em mới thử thấy cũng tố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
ko đc bác ah.nó báo lỗi . Bác xem lại cho em với

Chào bạn Phamvanthiet108,

Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp đã được chạy thử trên file bạn đã boundary xong chứ không phải file chưa tạo boundary bạn nhé. Việc tạo Boundary mình chưa giải quyết được.

Việc ghi diện tích ra file hay vẽ lên bản vẽ mình không làm do thiết nghĩ không phải quá khó đối với bạn.

Hy vọng bạn sẽ hài lòng dùng tạm.

(defun c:TDT ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac doan can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 dtlst (list) ssent (ssadd) area1 0 )
(while (	(setq PT (ssname TH DEM))
(setq CSDL (entget pt))
(setq TDT (cdr (assoc 0 CSDL)))
             (if (equal (cdr  (assoc 70 csdl)) 1 0.0001)
                 (progn
                 (setq dtlst (append dtlst (list pt)))
                 (setq ssent (ssadd pt ssent))
                 )
             )
(setq DEM (1+ DEM))
)
;;;;;;;;;(setq ssent1 (ssadd))
(foreach dt dtlst
            (setq els (entget dt))
            (setq plst (list))
            (foreach a els
                        (if (= (car a ) 10)
                            (setq plst (append plst (list (cdr a ))))
                        )
              )
              (setq ss1 (ssget "WP" plst (list (cons 0 "lwpolyline"))))
              (if ss1
                   (progn
                             (setq n (sslength ss1)
                                         i 0
                              )
                              (while (                                        (setq en (ssname ss1 i )
                                               ssent (ssdel en ssent )
                                       )
                                       (command "area" "o" en )
                                       (setq area1 (+ area1 (getvar "area"))
                                               i (1+ i)
                                        )
                                 )
                                 ;;;;;;;;;;;;;;;(setq ssent (ssdel dt ssent)
                                         ;;;;;;;;;;ssent1 (ssadd dt ssent1)
                                 ;;;;;;;;;;;;;;;:lol:
                       )
                 )


)
area1
ssent
(setq j 0)
(repeat (sslength ssent)
          (setq ent (ssname ssent j))
          (command "area" "o" ent)
          (setq CDPT (getvar "AREA"))
          (setq TOCD (+ TOCD CDPT) )
          (setq j (1+ j))
)
(setq TOCD (- TOCD area1))                

(setvar "cmdecho" cmd)
(princ "\nTong dien tich la:")
(setq TCD TOCD)
)

 

Chúc bạn vui.

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
Chào bạn Phamvanthiet108,

Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp đã được chạy thử trên file bạn đã boundary xong chứ không phải file chưa tạo boundary bạn nhé. Việc tạo Boundary mình chưa giải quyết được.

Việc ghi diện tích ra file hay vẽ lên bản vẽ mình không làm do thiết nghĩ không phải quá khó đối với bạn.

Hy vọng bạn sẽ hài lòng dùng tạm.

(defun c:TDT ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac doan can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 dtlst (list) ssent (ssadd) area1 0 )
(while (< DEM SPT)
(setq PT (ssname TH DEM))
(setq CSDL (entget pt))
(setq TDT (cdr (assoc 0 CSDL)))
             (if (equal (cdr  (assoc 70 csdl)) 1 0.0001)
                 (progn
                 (setq dtlst (append dtlst (list pt)))
                 (setq ssent (ssadd pt ssent))
                 )
             )
(setq DEM (1+ DEM))
)
;;;;;;;;;(setq ssent1 (ssadd))
(foreach dt dtlst
            (setq els (entget dt))
            (setq plst (list))
            (foreach a els
                        (if (= (car a ) 10)
                            (setq plst (append plst (list (cdr a ))))
                        )
              )
              (setq ss1 (ssget "WP" plst (list (cons 0 "lwpolyline"))))
              (if ss1
                   (progn
                             (setq n (sslength ss1)
                                         i 0
                              )
                              (while (< i n)
                                       (setq en (ssname ss1 i )
                                               ssent (ssdel en ssent )
                                       )
                                       (command "area" "o" en )
                                       (setq area1 (+ area1 (getvar "area"))
                                               i (1+ i)
                                        )
                                 )
                                 ;;;;;;;;;;;;;;;(setq ssent (ssdel dt ssent)
                                         ;;;;;;;;;;ssent1 (ssadd dt ssent1)
                                 ;;;;;;;;;;;;;;;:lol:
                       )
                 )


)
area1
ssent
(setq j 0)
(repeat (sslength ssent)
          (setq ent (ssname ssent j))
          (command "area" "o" ent)
          (setq CDPT (getvar "AREA"))
          (setq TOCD (+ TOCD CDPT) )
          (setq j (1+ j))
)
(setq TOCD (- TOCD area1))                

(setvar "cmdecho" cmd)
(princ "\nTong dien tich la:")
(setq TCD TOCD)
)

 

Chúc bạn vui.

Em rất cảm cảm bác Bình đã quan tâm đến vấn đề của em.

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
Em rất cảm cảm bác Bình đã quan tâm đến vấn đề của em.

Hề hề hề,

Nếu có thể bác cho mình ngó cái lisp bác dùng để tạo boundary với. Mình loay hoay chưa ngộ ra cái đường lối chi cả. Phương án của bác Thiếp mình cũng đã có thấy xong giờ tìm hoài chửa ra nên không rõ có ứng dụng được vào trường hợp của bác hay không???

Trong bản vẽ bác post lên mình thấy có nhẽ có thể cải sửa cái việc tạo boundary của bác vì thực tế trên đó mình thấy còn khá nhiều đường polyline hở trùng với các boundary. Do vậy mình phải dùng phép chọ chỉ lấy các polyline kín để đỡ rối bác ạ.

Việc mình thấy khá hay là giải quyết trường hợp có nhiều boundary lồng nhau tạo thêm các đảo cấp hai, cấp ba, hay cấp 4 ..... nữa. Vì thực tế không phải hiếm các trường hợp này, nhất là với mấy cái vùng sông nước mênh mông như miền Nam này. Tuy nhiên nghĩ là vậy nhưng còn chửa tìm ra thuật toán sao cho hợp lý nhất. Rất mong các bác góp thêm ý kiến để có thể giải quyết tận gốc vấn đề này.

Hề hề hề.....

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

- Mình muốn nhờ mọi người viết cho lisp điền giá trị đo được là diện tích (được pick chọn từ hatch or poline khép kín), chiều dài (được pick chọn từ pline, line vào block thuộc tính đã được lập sẵn.

- Cụ thể cấu trúc lisp như sau :

+ Tên lệnh : DTCD

+ Chọn vùng diện tích

+ Chọn đoạn thẳng

+ Chọn block cần điền ( block có tên BG đã đc lập sẵn)

- Chú ý : phải chọn diện tích trước vì thứ tự điền giá trị trong block thuộc tính mình đã lập là để diện tích trước xong đến chiều dài.

- Anh em xem giùm nhé,có chỗ nào chưa rõ ý của mình thì để mình nói thêm dau nhé.

- Link file cad kèm theo: http://www.cadviet.com/upfiles/3/cadvietcom.dwg

- Cám ơn đã quan tâm .

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
Em nghĩ thế này nè, nếu vậy thì kết hợp được luôn:

1. Quét chọn các tex, nhập tdt

2. Líp hỏi: " bạn có muốn giữ nguyên text không": "y/n"

Nếu chọn "y" thì :

" Bạn có muốn số bắt đầu tăng"

ví dụ: nhập 5 thì các text tăng : 5,6,7,8...

nhập 100 thì các text tăng : 100,101,102,103....

Nếu chọn "n" thì:

" Bạn có muốn thêm kí tự vào không"

3. ......

4. ...... các bước tiếp theo thì cứ như lisp phía trên.

5. Kết thúc.

 

Tương tự, Block ATT cũng vậy.

Không biết như vậy thì viết lisp quá phức tạp không nữa,

Mong anh giúp cho em với.

 

Em nghĩ chắc vấn đề này khó quá nên không thấy ai trả lời,

nói chung có mấy lisp cũ xài cũng tuyệt lắm rùi, hehe....

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
Em nghĩ chắc vấn đề này khó quá nên không thấy ai trả lời,

nói chung có mấy lisp cũ xài cũng tuyệt lắm rùi, hehe....

Bạn cứ "gáy" anh em. Mình sẽ giúp bạn. Vấn đề này cũng không khó lắm mình nghĩ bạn cũng làm được nên không động đế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
- Mình muốn nhờ mọi người viết cho lisp điền giá trị đo được là diện tích (được pick chọn từ hatch or poline khép kín), chiều dài (được pick chọn từ pline, line vào block thuộc tính đã được lập sẵn.

- Cụ thể cấu trúc lisp như sau :

+ Tên lệnh : DTCD

+ Chọn vùng diện tích

+ Chọn đoạn thẳng

+ Chọn block cần điền ( block có tên BG đã đc lập sẵn)

- Chú ý : phải chọn diện tích trước vì thứ tự điền giá trị trong block thuộc tính mình đã lập là để diện tích trước xong đến chiều dài.

- Anh em xem giùm nhé,có chỗ nào chưa rõ ý của mình thì để mình nói thêm dau nhé.

- Link file cad kèm theo: http://www.cadviet.com/upfiles/3/cadvietcom.dwg

- Cám ơn đã quan tâm .

Bạn hãy gửi lại file nhé, file đã gửi không mở đượ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
Bạn hãy gửi lại file nhé, file đã gửi không mở được.

- Cám ơn ban phamthanhbinh đã quan tâm file vừa download lại về vẫn mở dc bạn à. Mình dùng cad 2007, để thuận tiện mình up lại file đó lên ( đã chuyển sang cad 2004). Bình và a em giúp mình nhé

- http://www.cadviet.com/upfiles/3/cadvietcom_1.dwg

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ám ơn ban phamthanhbinh đã quan tâm file vừa download lại về vẫn mở dc bạn à. Mình dùng cad 2007, để thuận tiện mình up lại file đó lên ( đã chuyển sang cad 2004). Bình và a em giúp mình nhé

- http://www.cadviet.com/upfiles/3/cadvietcom_1.dwg

Drawing file is not valid

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ác bác cao thủ ơi viết giùm em cái list thống kê bản vẽ cho khung tên này với . em đang rất rất cần. bớt chút thời gian viết giùm em nhe . chân thành cảm ơn . mong co tin sơm nhât .thanks các bác rất nhìu nhìu http://www.cadviet.com/upfiles/3/khung_ten_4.dwg

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
Hề hề hề,

Nếu có thể bác cho mình ngó cái lisp bác dùng để tạo boundary với. Mình loay hoay chưa ngộ ra cái đường lối chi cả. Phương án của bác Thiếp mình cũng đã có thấy xong giờ tìm hoài chửa ra nên không rõ có ứng dụng được vào trường hợp của bác hay không???

Trong bản vẽ bác post lên mình thấy có nhẽ có thể cải sửa cái việc tạo boundary của bác vì thực tế trên đó mình thấy còn khá nhiều đường polyline hở trùng với các boundary. Do vậy mình phải dùng phép chọ chỉ lấy các polyline kín để đỡ rối bác ạ.

Việc mình thấy khá hay là giải quyết trường hợp có nhiều boundary lồng nhau tạo thêm các đảo cấp hai, cấp ba, hay cấp 4 ..... nữa. Vì thực tế không phải hiếm các trường hợp này, nhất là với mấy cái vùng sông nước mênh mông như miền Nam này. Tuy nhiên nghĩ là vậy nhưng còn chửa tìm ra thuật toán sao cho hợp lý nhất. Rất mong các bác góp thêm ý kiến để có thể giải quyết tận gốc vấn đề này.

Hề hề hề.....

Em dùng lệnh trong Hatch(Em kích vào đối tượng Hatch và sử dùng lệnh Recreateboundary ) để tạo ra đường bo sau đó em dùng lisp nối các đường line lại với nhau thôi.Em kích vào đối tượng Hatch và sử dùng lệnh Recreateboundary.

  • 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

Bạn ơi, cho mình hỏi có lisp nào tính tổng độ dài của nhiều đoạn thẳng mà mình chỉ định được ko ???

Nếu có thì cho mình xin

Hiện mình đang rất cần :lol:

Cảm ơn nhiều :lol: :lol: :cheers:

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
Bạn ơi, cho mình hỏi có lisp nào tính tổng độ dài của nhiều đoạn thẳng mà mình chỉ định được ko ???

Nếu có thì cho mình xin

Cảm ơn rất nhiều :lol: :lol: :lol:

 

Lần sau hãy chịu khó tìm kiếm trước khi yêu cầu bạn ơi.Chứ cứ yêu cầu toàn những thứ đã có thì các bác trên diễn đàn cũng nản khi fải đi tìm lại hay giải thích cho bạn.Sau đây là 1 Link ví dụ.Bạn mà chịu khó ngồi tìm kiếm chắc chắn sẽ tìm thấy nhiều hơn những jì mong đợi đó.Chúc vui.

 

http://www.cadviet.com/forum/index.php?showtopic=8438

  • Vote tăng 2

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ám ơn ban phamthanhbinh đã quan tâm file vừa download lại về vẫn mở dc bạn à. Mình dùng cad 2007, để thuận tiện mình up lại file đó lên ( đã chuyển sang cad 2004). Bình và a em giúp mình nhé

- http://www.cadviet.com/upfiles/3/cadvietcom_1.dwg

Invalid group code.

Hề hề hề, bó tay.....

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ác bác cao thủ ơi viết giùm em cái list thống kê bản vẽ cho khung tên này với . em đang rất rất cần. bớt chút thời gian viết giùm em nhe . chân thành cảm ơn . mong co tin sơm nhât .thanks các bác rất nhìu nhìu http://www.cadviet.com/upfiles/3/khung_ten_4.dwg

Chào bạn innuzasha,

Có phải bạn cần cái này không???

Lần sau nên post rõ ràng nội dung cái bạn cần nhé, lisp này là mình tự phỏng đoán mà viết nên có thể không giống cái bạn cần. Hãy tự trách mình chứ đừng trách cái lisp bạn nhé. Hề hề hề....

(defun c:tkbv ( )
(setq tk (getstring t "/n Nhap ten block khung ten: "))
(if tk
(setq sbv (ssget "x" (list (cons 0 "insert") (cons 2 tk))))
) 
(if sbv
(setq n (sslength sbv))
(alert "Khong co ban ve dung khung ten ban chon"
)
(alert (strcat "So ban ve su dung khung ten " tk " la " (rtos n 2 0)))
)

Chúc bạn vui, nếu cần bổ sung gì thì post lên nhé. Hề hề hề.

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
Chào bạn innuzasha,

Có phải bạn cần cái này không???

Lần sau nên post rõ ràng nội dung cái bạn cần nhé, lisp này là mình tự phỏng đoán mà viết nên có thể không giống cái bạn cần. Hãy tự trách mình chứ đừng trách cái lisp bạn nhé. Hề hề hề....

(defun c:tkbv ( )
(setq tk (getstring t "/n Nhap ten block khung ten: "))
(if tk
(setq sbv (ssget "x" (list (cons 0 "insert") (cons 2 tk))))
) 
(if sbv
(setq n (sslength sbv))
(alert "Khong co ban ve dung khung ten ban chon"
)
(alert (strcat "So ban ve su dung khung ten " tk " la " (rtos n 2 0)))
)

Chúc bạn vui, nếu cần bổ sung gì thì post lên nhé. Hề hề hề.

Bác bình xem lại hộ với.lisp ko sử dụng được bác ah

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
Bác bình xem lại hộ với.lisp ko sử dụng được bác ah

Hề hề hề,

Nó báo lỗi gì hở bác,

Mình đã kiểm tra trên file của bạn gì gì đó có cái block khung tên khá oái oăm mà nó vẫn chạy phe phé mà. Bác cần kiểm tra trước cái tên block khung tên của bác kẻo nó nhận nhằng thì khổ bác ạ.

Để lấy tên cho chuẩn bác cứ xài thằng (setq tk (cdr (assoc 2 (entget (car (entsel)))))) là nó sẽ đúng bác ạ. Lúc lisp hỏi bác chọn vô cái block khung tên là nó chuẩn ngay.

Sở dĩ mình để lisp yêu cầu phải nhập tên khung bản vẽ, ấy là vì bạn gì gì đó đưa ra cái tên block hơi oái oăm nên mình muốn để xem bạn đó sẽ nhập tên block kiểu chi mà thôi. Mình thì mình chơi kiểu quét chọn rồi copy chứ không nhập từ bàn phím được. Hề hề hề.....

Bác xem nó nè

http://www.cadviet.com/upfiles/3/mh1.jpg

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
Bạn cứ "gáy" anh em. Mình sẽ giúp bạn. Vấn đề này cũng không khó lắm mình nghĩ bạn cũng làm được nên không động đến.

Hehe, anh Tú vui tính quá, quả thực là em đang mò lisp, mà viết hoài không xong, nên nhờ mấy anh trên diễn đàn giúp, để khắc phục đó mà, hihi...

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
Bạn ơi, cho mình hỏi có lisp nào tính tổng độ dài của nhiều đoạn thẳng mà mình chỉ định được ko ???

Nếu có thì cho mình xin

Hiện mình đang rất cần :lol:

Cảm ơn nhiều :lol: :lol: :cheers:

 

Lisp này phải không bạn, trên diễn đán Cad viet có đó bạn:

;;;--- ADDLEN.lsp - Total lengths of objects. 
;;;    Polylines, LWPolylines, Splines, Arcs, Circles, Lines, and Ellipse
;;;
;;;
;;;
;;;--- Copyright 2005 by JefferyPSanders.com
;;;    All rights reserved.
;;;
;;;
;;;
;;;--- Created on 11/25/05
;;;


(defun c:AD()

 (setvar "cmdecho" 0)

 ;;;--- Function to get the length of an ARC entity
 (defun getArc(en)
   (command "lengthen" en "")
   (getvar "perimeter")
 )

 ;;;--- Function to get the length of a LINE entity
 (defun getLine(en)
   (setq enlist(entget en))
   (distance (cdr(assoc 10 enlist)) (cdr(assoc 11 enlist)))
 )

 ;;;--- Function to get the length of a POLY, CIRCLE, SPLINE, OR ELLIPSE
 (defun getPoly(en)
   (command "area" "Object" en)
   (getvar "perimeter")
 )  

 ;;;--- Main application

 ;;;--- Let the user select objects
 (if(setq eset(ssget))
   (progn

     ;;;--- Set up a variable to hold the length
     (setq totalLen 0)

     ;;;--- Set up a counter
     (setq cntr 0)

     ;;;--- Cycle through each entity in the selection set
     (while(< cntr (sslength eset))

       ;;;--- Get the first entity's name
       (setq en(ssname eset cntr))

       ;;;--- Get the DXF group codes
       (setq enlist(entget en))

       ;;;--- Get the type of entity
       (setq enType(cdr(assoc 0 enlist)))

       ;;;--- Get the length based on entity type
       (cond
         ((= enType "ARC"       )(setq len(getArc en)))
         ((= enType "CIRCLE"    )(setq len(getPoly en)))
         ((= enType "ELLIPSE"   )(setq len(getPoly en)))
         ((= enType "LINE"      )(setq len(getLine en)))
         ((= enType "LWPOLYLINE")(setq len(getPoly en)))
         ((= enType "POLYLINE"  )(setq len(getPoly en)))
         ((= enType "SPLINE"    )(setq len(getPoly en)))
         (T (setq len 0.0))
       )

       ;;;--- Format the entity type to be 12 characters long
       (while(< (strlen enType) 12)(setq enType(strcat enType " ")))

       ;;;--- Inform the user of progress
       (princ "\n Found ")
       (princ enType)
       (princ " with a length of: ")
       (princ (rtos len))

       ;;;--- Total the length
       (setq totalLen(+ totalLen len))


       ;;;--- Increment the counter to get the next entity
       (setq cntr (+ cntr 1))
     )
   )
 )

 (setvar "cmdecho" 1)

 ;;;--- Inform the user of the results
 (alert (strcat "\n Found " (itoa cntr) " entitie(s) with a Total Length of " (rtos totalLen)))

 ;;;--- Suppress the last echo for a clean exit
 (princ)
)

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

Mấy hôm nay vẽ thép gần 50 bản, mình phải liên tục chuyển số liệu từ Excel sang Cad : vào edit - paste special - autocad entities --- lặp lại các bước trên cả trăm lần đuối quá, bạn nào giúp mình viết 1 lisp thực hiện các bước trên chỉ bằng 1 lệnh được k, mình cám ơn rất nhiều :lol:

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
Mấy hôm nay vẽ thép gần 50 bản, mình phải liên tục chuyển số liệu từ Excel sang Cad : vào edit - paste special - autocad entities --- lặp lại các bước trên cả trăm lần đuối quá, bạn nào giúp mình viết 1 lisp thực hiện các bước trên chỉ bằng 1 lệnh được k, mình cám ơn rất nhiều :lol:

Bạn up file mẫu lên đi (ghi rõ đối tượng gốc và kết quả)

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×