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

[Phiphi- 176]

Phiphi dùng lisp IMF (insert multi files) dưới đây

...

Xin bác Nguyen Hoanh sửa thêm 1 chút để các bản vẽ sắp xếp đúng theo thứ tự của các filenames.

Dùng LISP trên thì kết quả sau khi ghép các b/v thì chỉ cho ra theo thứ tự 1,10, 11....19, 2, 20, 21,..., 23, 3, 4, 5....

Mặc định điểm chèn là 0,0.

Cám ơn nhiều.

[Nguyen Hoanh 4.663]

Xin bác Nguyen Hoanh sửa thêm 1 chút để các bản vẽ sắp xếp đúng theo thứ tự của các filenames.

Dùng LISP trên thì kết quả sau khi ghép các b/v thì chỉ cho ra theo thứ tự 1,10, 11....19, 2, 20, 21,..., 23, 3, 4, 5....

Cám ơn nhiều.

Cái này khá phức tạp.

 

Nếu có thể, bạn rename file 1 -> 01, 2->02,..9->09 thì lisp sẽ chạy đúng.

 

Sở dĩ có chuyện này là vì lisp chỉ xem tên file là chuỗi (text) chứ không xem như số (number).

[Nguyen Hoanh 4.663]

Cái này khá phức tạp.

 

Nếu có thể, bạn rename file 1 -> 01, 2->02,..9->09 thì lisp sẽ chạy đúng.

 

Sở dĩ có chuyện này là vì lisp chỉ xem tên file là chuỗi (text) chứ không xem như số (number).

Vừa post xong thì nghĩ lại, thấy cũng không phức tạp lắm.

 

Phiphi thử lisp cải tiến dưới đây

 

(defun c:imf ()
 (defun sosanh	(a b )
   (defun ne (s)
     (atoi (vl-list->string
      (vl-remove-if
	'(lambda (x) (or ( x 57)))
	(vl-string->list s)
      )
    )
     )
   )
   (  )
 (setq	pathname (vl-filename-directory
	   (getfiled "Hay chon file dwg bat ky thuoc thu muc"
		     ""
		     "dwg"
		     0
	   )
	 )
filelist (vl-sort (vl-directory-files pathname "*.dwg") 'sosanh)
p	 (getpoint "\nDiem chen: ")
xht	 (car p)
yht	 (cadr p)
 )
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (foreach filename filelist
   (command "-insert"
     (strcat pathname "/" filename)
     (list xht yht)
     1.0
     1.0
     0.0
   )
   (vla-getboundingbox
     (vlax-ename->vla-object (entlast))
     'p1
     'p2
   )
   (setq
     p1     (vlax-safearray->list p1)
     p2     (vlax-safearray->list p2)
     xht    (+ xht (abs (car (mapcar '- p2 p1))))
     blname (cdr (assoc 2 (entget (entlast))))
   )
   (command ".explode" (entlast) "")
   (command "-purge" "Block" blname "N")
 )
 (setvar "osmode" oldos)
 (princ)
)

[Phiphi- 176]

Lisp trên của Nguyen Hoanh dùng để ghép các b/v thành một b/v chung.

Vậy nếu trường hợp ngược lại là muốn tách các b/v trong 1 b/v chung thành những b/v đơn thì LISP có thể thực hiện được không bác Nguyen Hoanh?

PP có 1 Lisp dưới đây của Jimmy Bergmark, nhưng chỉ tách các b/v trong các layout (Paper Space) thành các b/v đơn.

+Lệnh là LayoutsToDwg

;;;    LayoutsToDwgs.lsp
;;;    Created 2000-03-27

;;; By Jimmy Bergmark
;;; Copyright © 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; 2003-12-12 Sets UCS to world in model space to avoid problem with wblock
;;;

;;;    For AutoCAD 2000, 2000i, 2002, 2004
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Creates drawings of all layouts.
;;;   Only one layout at a time is saved, the rest are deleted.
;;;   This is handy when you want to save to pre A2k versions.
;;;   The new drawings are saved to the current drawings path
;;;   and overwrites existing drawings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:LayoutsToDwgs (/ fn path msg msg2 fileprefix)
 (defun DelAllLayouts (Keeper / TabName)
   (vlax-for Layout
                    (vla-get-Layouts
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
     (if
       (and
         (/= (setq TabName (strcase (vla-get-name layout))) "MODEL")
         (/= TabName (strcase Keeper))
       )
        (vla-delete layout)
     )
   )
 )

 (vl-load-com)
 (setq msg "")
 (setq msg2 "")
 (command "._undo" "_BE")
 (setq fileprefix (getstring "Enter filename prefix: "))
 (foreach lay (layoutlist)
   (if (/= lay "Model")
     (progn
       (command "_.undo" "_M")
       (DelAllLayouts lay)
       (setvar "tilemode" 1)
       (command "ucs" "w")
       (setvar "tilemode" 0)
       (setq path (getvar "DWGPREFIX"))
       (setq fn (strcat path fileprefix lay ".dwg"))
       (if (findfile fn)
         (progn
           (command ".-wblock" fn "_Y")
           (if (equal 1 (logand 1 (getvar "cmdactive")))
             (progn
               (setq msg (strcat msg "\n" fn))
               (command "*")
             )
             (setq msg2 (strcat msg2 "\n" fn))
           )
         )
         (progn
           (command ".-wblock" fn "*")
           (setq msg (strcat msg "\n" fn))
         )
       )
       (command "_.undo" "_B")
     )
   )
 )
 (if (/= msg "")
   (progn
     (prompt "\nFollowing drawings were created:")
     (prompt msg)
   )
 )
 (if (/= msg2 "")
   (progn
     (prompt "\nFollowing drawings were NOT created:")
     (prompt msg2)
   )
 )
 (command "._undo" "_E")
 (textscr)
 (princ)
)

[Nguyen Hoanh 4.663]

Lisp trên của Nguyen Hoanh dùng để ghép các b/v thành một b/v chung.

Vậy nếu trường hợp ngược lại là muốn tách các b/v trong 1 b/v chung thành những b/v đơn thì LISP có thể thực hiện được không bác Nguyen Hoanh?

PP có 1 Lisp dưới đây của Jimmy Bergmark, nhưng chỉ tách các b/v trong các layout (Paper Space) thành các b/v đơn.

+Lệnh là LayoutsToDwg

Tất nhiên là được, nhưng muốn hỏi Phiphi thêm một số thông tin:

- tên file được đặt theo nguyên tắc nào?

- Các khung tên được sắp xếp ra sao? (trên một hàng hay theo ma trận nhiều hàng)

[phamthanhbinh 3.146]

Phiphi dùng lisp IMF (insert multi files) dưới đây

 

(defun c:imf()
 (setq pathname (vl-filename-directory (getfiled "Hay chon file dwg bat ky thuoc thu muc" "" "dwg" 0))
filelist (vl-sort (vl-directory-files pathname "*.dwg") '	p (getpoint "\nDiem chen: ")
xht (car p)
yht (cadr p)	
 )
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (foreach filename filelist    
   (command "-insert" (strcat pathname "/" filename) (list xht yht) 1.0 1.0 0.0)
   (vla-getboundingbox (vlax-ename->vla-object (entlast)) 'p1 'p2)    
   (setq
     p1 (vlax-safearray->list p1)
     p2 (vlax-safearray->list p2)      
     xht (+ xht (abs (car (mapcar '- p2 p1))))
     blname (cdr (assoc 2 (entget (entlast))))
   )
   (command ".explode" (entlast) "")    
   (command "-purge" "Block" blname "N")
 )
 (setvar "osmode" oldos)
 (princ)
)

Chào bác Hoành.

Đọc cái líp của bác và chạy hử mình thấy có thắc mắc như sau:

Tại sao theo lisp thì bác chỉ insert mỗi bản vẽ có 1 lần theo trật tự của cái filelist. Vậy mà kết quả thì mỗi bản vẽ được insert hai lần, một lần theo hàng ngang với đúng thứ tự của filelist và một lần nó tự sắp xếp thành một bảng có 5 cột và theo trật tự số từ 1 tới 23 bác ạ.

Vậy cái lần insert thú hai này là do đâu? Bác có thể giải thích thêm một chút chỗ này được không???

[Nguyen Hoanh 4.663]

Chào bác Hoành.

Đọc cái líp của bác và chạy hử mình thấy có thắc mắc như sau:

Tại sao theo lisp thì bác chỉ insert mỗi bản vẽ có 1 lần theo trật tự của cái filelist. Vậy mà kết quả thì mỗi bản vẽ được insert hai lần, một lần theo hàng ngang với đúng thứ tự của filelist và một lần nó tự sắp xếp thành một bảng có 5 cột và theo trật tự số từ 1 tới 23 bác ạ.

Vậy cái lần insert thú hai này là do đâu? Bác có thể giải thích thêm một chút chỗ này được không???

là vì trong tập hợp các file Phiphi gửi có 1 file tên là Multiple drawings.dwg chứa kết quả (làm ví dụ).

 

Lisp chèn tất cả các file + file kết quả -> bác Bình nhìn thấy 2 lần kết quả.

[phamthanhbinh 3.146]

là vì trong tập hợp các file Phiphi gửi có 1 file tên là Multiple drawings.dwg chứa kết quả (làm ví dụ).

 

Lisp chèn tất cả các file + file kết quả -> bác Bình nhìn thấy 2 lần kết quả.

Vừa pót xong mới phát hiện ra bác ạ, tại cái file multi... của bác phi phi.

Xin lỗi đã làm phiền bác.

[Phiphi- 176]

Tất nhiên là được, nhưng muốn hỏi Phiphi thêm một số thông tin:

- tên file được đặt theo nguyên tắc nào?

- Các khung tên được sắp xếp ra sao? (trên một hàng hay theo ma trận nhiều hàng)

1. Tên file sẽ dủng 1 attribute value của 1 Tagname trong khung tên do User chọn.

(thí du Tagname DRAWING_NUMBER trong các b/v mẫu PP đã post)

2. Cách trình bảy hợp lý nhất là dạng ma trận phù hợp với kích thước của User's monitors (16:9-wide screen hoặc 4:3), vì khi zoom all các b/v sẽ được fit toàn bộ trên màn hình.

Với LISP ghép chung b/v trên của Bác, PP nghỉ rằng Bác thêm vào phép tính tổng số files chia với tỷ lệ của monitor, Lisp sẽ tự động dàn theo ma trận hợp lý nhất.

Thank you Bác.

[Nguyen Hoanh 4.663]

1. Tên file sẽ dủng 1 attribute value của 1 Tagname trong khung tên do User chọn.

(thí du Tagname DRAWING_NUMBER trong các b/v mẫu PP đã post)

2. Cách trình bảy hợp lý nhất là dạng ma trận phù hợp với kích thước của User's monitors (16:9-wide screen hoặc 4:3), vì khi zoom all các b/v sẽ được fit toàn bộ trên màn hình.

Với LISP ghép chung b/v trên của Bác, PP nghỉ rằng Bác thêm vào phép tính tổng số files chia với tỷ lệ của monitor, Lisp sẽ tự động dàn theo ma trận hợp lý nhất.

Thank you Bác.

Phiphi dùng lệnh EXF (EXtract file) sau đây:

(defun c:exf ()
 (defun filenamevalid(str)
   (vl-list->string (vl-remove-if '(lambda (x) (member x (vl-string->list "\\/:?>|"))) (vl-string->list str)))
 )
 (defun getboundingbox	(ent / p1 p2)
   (vla-getboundingbox
     (vlax-ename->vla-object ent)
     'p1
     'p2
   )
   (list
     (setq p1 (vlax-safearray->list p1))
     (setq p2 (vlax-safearray->list p2))
   )
 )
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (if	ss
      (sslength ss)
      0
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )

 (defun dxf (ent code)
   (cdr (assoc code (entget ent)))
 )
 (defun gettag	(ent / entbl lst)
   (setq entbl ent)
   (while (and	(setq entbl (entnext entbl))
	(= (dxf entbl 0) "ATTRIB")
   )
     (setq lst (append lst (list (cons (dxf entbl 2) (dxf entbl 1)))))
   )
   lst
 )
 (setq
   entbl  (car (entsel "\nHay pick vao block khung ten"))
   blname (dxf entbl 2)
   taglst (gettag entbl)
   index  0
 )
 (princ "\nCac tag trong block:")
 (foreach pp taglst
   (princ (strcat "\n" (itoa index) ": " (car pp)))
   (setq index (1+ index))
 )
 (textscr)
 (setq
   tag	(car
  (nth (getint "\nHay nhan 0,1,2... de chon tag: ") taglst)
)
 )
 (graphscr)
 (command ".zoom" "e")
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)

 (setq	ss  (ssget "x" (list (cons 0 "INSERT") (cons 2 blname)))
lst (ss2ent ss)
lst (mapcar '(lambda (e) (append (list e (cdr (assoc tag (gettag e)))) (getboundingbox e))) lst)
 )

 (foreach pp lst
   (setq e (nth 0 pp)
  f (strcat (getvar "dwgprefix") (filenamevalid (nth 1 pp)) ".dwg")
  p1 (nth 2 pp)
  p2 (nth 3 pp)
  ss (ssget "_w" p1 p2)
  ss (ssadd e ss)
   )
   (command ".wblock" f) 
   (if (setq fh (open f "r")) (progn (close fh) (command "y")))
   (command "" p1 ss "")
   (command ".oops")
 )  

 (setvar "osmode" oldos)
 (command ".zoom" "p")
 (princ)
)

 

Lưu ý là lisp sẽ overwrite các file có cùng tên, nếu chạy file Multiple drawings.dwg thì chỉ có được 1 kết quả duy nhất là SK-123456-001-X-01.dwg do các khung tên có attribute DRAWING_NUMBER giống nhau.

Chỉnh sửa Tháng 3 27, 2010 theo Nguyen Hoanh
Chỉnh sửa lại chỗ bị sai của lisp

[truongthanh 7]

Xin chân thành cảm ơn bạn truongthanh lệnh br2 chính là thứ mình đang cần. Mình là dân cơ khí nên rất cần nó để chuyển phần bị che khuất sang nét đứt.

Tiện thể bạn cho mình hỏi cách xem nội dung lisp br.fas của bạn. Lisp *.lsp thì có thể xem bằng note còn *.fas thì xem bằng cách nào, mình cũng đang muốn học lisp? Thank bạn

xin lỗi bạn nhé!mình down dc file FAS này thôi!mình ko có file LISP!

[Phiphi- 176]

Phiphi dùng lệnh EXF (EXtract file) sau đây:

...

Lưu ý là lisp sẽ overwrite các file có cùng tên, nếu chạy file Multiple drawings.dwg thì chỉ có được 1 kết quả duy nhất là SK-123456-001-X-01.dwg do các khung tên có attribute DRAWING_NUMBER giống nhau.

PP nhờ Bác chỉnh thêm để các b/v sau khi tách riêng thì toạ độ 0,0 sẽ là góc trái phía dưới của khung tên (đây cũng chính là insert point của block khung tên)

Và làm cho Lisp IMF dàn bv theo dạng ma trận như PP đã post bài trên.

 

Áp dụng 2 Lisp IMF và EXF mà bác Nguyen Hoanh vửa mới viết, PP nghỉ rằng các Drafters, Designers, Checkers từ nay sẽ dể dàng hơn khi làm việc với số lượng nhiều bản vẽ.

Kết hợp với Lisp MPLOT cũng của bác Nguyen Hoanh viết, việc in ấn với số lượng lớn các bv này (ra giấy hoặc PDF) để review, giao cho khách hàng cũng sẽ rất thuận tiện nhanh chóng.

Cũng cần nhắc lại rẳng nếu 1 bv dùng nhiều Layouts trong Paper Space thì lệnh PUBLISH sẽ giúp việc in ấn hàng loạt như Lisp MPLOT của bác Hoanh.

Và đừng quên đến Lisp LayoutsToDwg mà PP đã giới thiệu bài trên cũng như Lisp CHSPACE có sẳn trong Express tool của AutoCAD.

Rất cám ơn sự nhiệt tình cống hiến của bác Nguyen Hoanh cho cộng đồng CadViet.com.

PP.

[Nguyen Hoanh 4.663]

PP nhờ Bác chỉnh thêm để các b/v sau khi tách riêng thì toạ độ 0,0 sẽ là góc trái phía dưới của khung tên (đây cũng chính là insert point của block khung tên)

Lisp EXF trước đây bị lỗi, đã chỉnh lại, Phiphi thử lại xem.

[Phiphi- 176]

Lisp EXF trước đây bị lỗi, đã chỉnh lại, Phiphi thử lại xem.

Vẫn như cũ bác Hoanh ơi.

[coxuong89 30]

em dùng lisp IMF của bác hoanh thì gặp lỗi sau...bác chỉ em với

Command: imf

 

Diem chen: -insert Enter block name or [?]: E:\Bao Chau\BIET THU LON/CHI

TIET.dwg

Units: Millimeters Conversion: 0.0394

Specify insertion point or [basepoint/Scale/X/Y/Z/Rotate]:

Enter X scale factor, specify opposite corner, or [Corner/XYZ] <1>:

1.000000000000000 Enter Y scale factor : 1.000000000000000

Specify rotation angle <0>: 0.000000000000000

Command: ; error: no function definition: VLAX-ENAME->VLA-OBJECT

[Tue_NV 3.912]

em dùng lisp IMF của bác hoanh thì gặp lỗi sau...bác chỉ em với

.....

Command: ; error: no function definition: VLAX-ENAME->VLA-OBJECT

Bạn thêm dòng (vl-load-com) vào code. Có thể thêm như sau :

(defun c:imf ()

(vl-load-com)

.......

-> Sau đó chạy Lisp là OK

 

Với cả Lisp exf nữa nhé

[Phiphi- 176]

PP nhờ Bác chỉnh thêm để các b/v sau khi tách riêng thì toạ độ 0,0 sẽ là góc trái phía dưới của khung tên (đây cũng chính là insert point của block khung tên)

Và làm cho Lisp IMF dàn bv theo dạng ma trận như PP đã post bài trên.

 

Áp dụng 2 Lisp IMF và EXF mà bác Nguyen Hoanh vửa mới viết, PP nghỉ rằng các Drafters, Designers, Checkers từ nay sẽ dể dàng hơn khi làm việc với số lượng nhiều bản vẽ.

Kết hợp với Lisp MPLOT cũng của bác Nguyen Hoanh viết, việc in ấn với số lượng lớn các bv này (ra giấy hoặc PDF) để review, giao cho khách hàng cũng sẽ rất thuận tiện nhanh chóng.

Cũng cần nhắc lại rẳng nếu 1 bv dùng nhiều Layouts trong Paper Space thì lệnh PUBLISH sẽ giúp việc in ấn hàng loạt như Lisp MPLOT của bác Hoanh.

Và đừng quên đến Lisp LayoutsToDwg mà PP đã giới thiệu bài trên cũng như Lisp CHSPACE có sẳn trong Express tool của AutoCAD.

Rất cám ơn sự nhiệt tình cống hiến của bác Nguyen Hoanh cho cộng đồng CadViet.com.

PP.

PP vừa tìm được 1 freeware tên là Bulk Rename Utility.

Phần mềm này chỉ có 1.8mb, dùng để thay đổi với số lượng lớn các filenames với bất kỳ kiểu nào mà User muốn có.

Các Bác hãy kết hợp dùng p/m này với các Lisp trên để có được các tên file như ý muốn.

Xin giới thiệu các Bác cùng nhau sử dụng (free): http://www.bulkrenameutility.co.uk/Main_Intro.php

Forum của p/m trên: http://www.bulkrenameutility.co.uk/forum/viewforum.php?f=4

[LXD 12]

Chào các Bác. Tôi dùng CAD Map, và việc ghép các bản vẽ là một tiện ích đã có trong đó (ghép các mảnh Bản đồ lại với nhau). Nhưng đòi hỏi các file phải nằm cùng hệ tọa độ (cùng định nghĩa). Tức là mặc dù mỗi Mảnh Bản đồ là 1 file dwg, nhưng khi insert với điểm gốc là 0,0 thì khớp nhau.

 

Nếu Bác nào đã cài CAD Map và muốn biết thì Tôi sẽ post bài về vấn đề này ạ.

 

Tôi cũng có nhu cầu chia 1 bản vẽ thành nhiều bản vẽ, hiện tại Tôi dùng lệnh Wblock (có lisp hỗ trợ), thao tác còn lại là chọn đường dẫn (chỉ lần đầu tiên), select obj, file name.

 

Tôi nghĩ là nếu để tự động thì hơi khó vì 2 vấn đề là quy luật đặt tên file và quy luật phân bố vị trí bản vẽ (bao nhiêu theo hàng ngang và hàng dọc)

 

Nhưng nhu cầu của Bác Phiphi và Tôi cũng có khác nhau.

 

+ Về ghép bản vẽ: Bác Phiphi- Ghép tự do phục vụ Check & Print. Còn tôi là đúng tọa độ để ghép Biên.

 

+ Tách bản vẽ: Điểm gốc bản vẽ Bác Phiphi- cần là 0,0. Còn tôi là giữ nguyên.

 

Vài dòng chia sẻ ạ.

-

[ngocchung1608 0]

Cắt các đối tượng : lines, lwplines, plines, splines, ellipse, circles & arcs tại các giao điểm.

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

Ngon. Líp này còn trên cả tuyệt. Thank bác lắm lắm

[connaivang 1]

Chào bác Nguyễn Hoành cùng toàn thể các bác trong diễn đàn.

Em muốn các bác viết cho em một đoạn lisp có nội dung như sau:

Sau khi đánh tên lệnh, CAD sẽ yêu cầu chọn đối tượng. Sau khi chọn được đối tượng, lisp có chức năng thống kê số lượng của từng loại đường tròn có đường kính khác nhau.(VD: -Duong tròn duong kinh la 10 có so luong la : 20 -Duong tròn duong kinh la 20 có so luong la : 30...)

Mong được các bác cao thủ trên diễn đàn giúp đỡ.

Chúc các bác mạnh khoẻ, công tác tốt và Xin cảm ơn nhiều.

[Tue_NV 3.912]

Chào bác Nguyễn Hoành cùng toàn thể các bác trong diễn đàn.

Em muốn các bác viết cho em một đoạn lisp có nội dung như sau:

Sau khi đánh tên lệnh, CAD sẽ yêu cầu chọn đối tượng. Sau khi chọn được đối tượng, lisp có chức năng thống kê số lượng của từng loại đường tròn có đường kính khác nhau.(VD: -Duong tròn duong kinh la 10 có so luong la : 20 -Duong tròn duong kinh la 20 có so luong la : 30...)

Mong được các bác cao thủ trên diễn đàn giúp đỡ.

Chúc các bác mạnh khoẻ, công tác tốt và Xin cảm ơn nhiều.

Bạn chạy thử Lisp này nhé :

(defun c:tkc(/ ss r lisr old Res kq)
 (setq ss (ssget '((0 . "CIRCLE"))) i -1 lisr '() Res '() kq "")
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq r (cdr (assoc 40 (entget ent))))
   (setq lisr (cons r lisr))
 )
(foreach x lisr
(if (setq old (assoc x Res))
(setq Res (subst (cons x (1+ (cdr old))) old Res))
(setq Res (append Res (list (cons x 1))))
)
)
 (foreach x Res
   (setq kq (STRCAT kq "Duong tron duong kinh la " (rtos (car x) 2 1) " \n co so luong la : "
	     (itoa(cdr x)) "\n\n"
     )
   )
 )
 (alert kq)
   (princ)
 )

[phamthanhbinh 3.146]

Bạn chạy thử Lisp này nhé :

(defun c:tkc(/ ss r lisr old Res kq)
 (setq ss (ssget '((0 . "CIRCLE"))) i -1 lisr '() Res '() kq "")
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq r (cdr (assoc 40 (entget ent))))
   (setq lisr (cons r lisr))
 )
(foreach x lisr
(if (setq old (assoc x Res))
(setq Res (subst (cons x (1+ (cdr old))) old Res))
(setq Res (append Res (list (cons x 1))))
)
)
 (foreach x Res
   (setq kq (STRCAT kq "Duong tron duong kinh la " (rtos (car x) 2 1) " \n co so luong la : "
	     (itoa(cdr x)) "\n\n"
     )
   )
 )
 (alert kq)
   (princ)
 )

Chào bác Tue_NV,

Đọc cái lisp của bác , mình mót được khá nhiều điều hay. Tỷ như cái cách lập vòng lặp While hay cách tạo biến res.

Tuy nhiên có một chỗ chưa đúng là cái thông báo kết quả, phải đổi lại là bán kinh chứ không phải đường kính bác ạ, vì bác lấy từ mã dxf 40 nên nó trả về bán kinh chứ không phải đường kính.

Bác kiểm tra lại nhé.

 

Còn một điều nữa là trong trường hợp các bán kính vòng tròn khác nhau không quá lớn, tỷ như là 0.01 đơn vị thì sẽ xảy ra kết quả hơi không đúng do trong thông báo kết quả bác lại làm tròn số bác ạ. Nên chăng ta cứ để nguyên giá trị bán kính mà khỏi làm tròn.??? Hoặc là ta làm tròn luôn bán kính trước khi tạo list các bán kính????

[hoa35ktxd 38]

Một phương pháp làm rất ngắn gọn và sáng tạo.

Bái phục, bái phục.

[vtd_xd 5]

Bác nào co lisp thống kê cấu kiện không vây? thanks

[thonghoang1 9]

s