Array đối tượng trong vùng

Tháng 8 14, 2010

Chào bạn thanhduan, anh Duy

Tue_NV viết 1 đoạn code trên thuật toán mà bạn thanhduan đưa ra :

(defun c:aic(/ ms pl minp maxp minpp name kc ssa ans line minp2)
 (vl-load-com)
 (command "undo" "be")
 (setvar "attreq" 0)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq ms (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))))
 (setq pl (vlax-ename->vla-object (car(entsel "\n Chon Polyline kin :"))))
 (vla-getboundingbox pl 'minp 'maxp)
 (setq minp (safearray-value minp))
 (setq maxp (safearray-value maxp))
 (setq name (getstring "\n Nhap ten Block / enter de chon doi tuong : ") ssa '())
 (if (= name "") (setq name (cdr(assoc 2 (entget (car(entsel "\n Chon Block :")))))))
 (setq kc (getdist "\n Khoang cach hang :"))
 (setq minpp (mapcar '- minp (list (distance maxp minp) (distance maxp minp) 0)))

 (vl-cmdf "insert" name minp 1 1 0.0)
       (setq dtd (vlax-ename->vla-object (entlast)))
 (setq minp2 (mapcar '+ minp (list (/ kc 2) (/ kc 2) 0.0)))
   (vl-cmdf "insert" name minp2 1 1 0.0)
       (setq dts (vlax-ename->vla-object (entlast)))
     (setq ssa
(append (list dtd)
        (vlax-invoke dtd 'ArrayRectangular
	  	(1+ (fix (/ (- (cadr maxp) (cadr minp)) kc)))
		(1+ (fix (/ (- (car maxp) (car minp)) kc)))
	  	1 kc kc 0
  	)
	(list dts)
	(vlax-invoke dts 'ArrayRectangular
	  	(1+ (fix (/ (- (cadr maxp) (cadr minp)) kc)))
		(1+ (fix (/ (- (car maxp) (car minp)) kc)))
	  	1 kc kc 0
  	)
)
    );setq
   ;;;;;;;;;  )
  ;;;;;;;;;;;;  )
 (initget "N T")
 (setq ans (getkword "\n Ban muon xoa cac doi tuong ngoai hay trong Polyline < N / T > :"))
 (foreach x ssa
   (setq line (vla-addline ms (vlax-3d-point minpp)
	 	       (vla-get-insertionpoint x)
       )
   )
   (if (= (strcase ans) "N")
     (progn
   	(if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 0)
     		(vla-erase x)
       )	
     )
   )
   (if (= (strcase ans) "T")
     (progn
   	(if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 1)
     		(vla-erase x)
       )	
     )
   )    

   (vla-erase line)
)
 (setvar "osmode" 0)
 (command "undo" "end")
)

Bạn thanhduan, anhDuy thử nhé

Chúc các bác 1 ngày cuối tuần vui vẻ :(

Bác Tue_NV ơi! Nếu em muốn tiếp tục dựa trên mảng bài toán này mà đi tiếp tục việc nghiên cứu xoá đối tượng trong vùng kín được chọn theo thuộc tính đã được lọc trong fillter (theo layer, theo block, theo màu sắc, kích thước .....)(thao tác "Fi" đã được lọc trước và được ứng dụng "p" trong yêu cầu này).

Thao tác như sau:

- Chọn vùng kín (chọn polyline)

- Chọn đối tượng cần xoá (nhấn "p")

- Chọn xóa đối tượng trong hay ngoài polyline

Em nghĩ là nó đơn giản hơn so với mảng array trong vùng

Bác Tue_NV giúp em chỉnh sửa luôn lisp này bác nhé.

Em cảm ơn bác rất nhiều.

Tháng 8 14, 2010

Bác Tue_NV ơi! Nếu em muốn tiếp tục dựa trên mảng bài toán này mà đi tiếp tục việc nghiên cứu xoá đối tượng trong vùng kín được chọn theo thuộc tính đã được lọc trong fillter (theo layer, theo block, theo màu sắc, kích thước .....)(thao tác "Fi" đã được lọc trước và được ứng dụng "p" trong yêu cầu này).
Thao tác như sau:

- Chọn vùng kín (chọn polyline)

- Chọn đối tượng cần xoá (nhấn "p")

- Chọn xóa đối tượng trong hay ngoài polyline

Em nghĩ là nó đơn giản hơn so với mảng array trong vùng

Bác Tue_NV giúp em chỉnh sửa luôn lisp này bác nhé.

Em cảm ơn bác rất nhiều.

Nếu bạn đã lọc trước đó thì không cần nhấn "p". Lisp sẽ làm chuyện đó cho bạn.

Nhưng có cái này Tue_NV muốn hỏi bạn :

Đối tượng thì có nhiều loại đối tượng vậy bạn?

Bạn có thể cho biết là bạn thao tác với đối tượng nào không?

Hay là với các loại đối tượng?

- Nếu là với các loại đối tượng thì :

các đối tượng giao với đa tuyến kín có bị cắt xén đi không?

-Có lẽ rằng bạn nên tham khảo thêm Lisp xoá các đối tượng trong vùng kín.

Lisp đó rất hay và đáp ứng được yêu cầu của bạn

Theo quan điểm và hiểu biết của mình thì mình kg ủng hộ việc tạo cấu trúc tô bằng block. Nó kg tiện bằng Hatch. Mình nói để bạn tham khảo thêm
Việc tạo và trải block sẽ rất khó quản lý và làm nặng bản vẽ

Block sẽ kg tự xén phần giáp biên và như vậy bạn phải "nổ" nó ra để cắt đi làm bv sẽ có thêm nhiều đối tượng vô nghĩa.

Nếu có hai hay nhiều đg bao kề nhau, việc xác định điểm xuất phát kg cẩn thận sẽ làm chúng bị lệch nhau.

......

Bản thân Tue_NV ủng hộ ý kiến của bạn TrungNgaMY. Sử dụng hay không là quyền của bạn.

Tháng 8 15, 2010

Nếu bạn đã lọc trước đó thì không cần nhấn "p". Lisp sẽ làm chuyện đó cho bạn.
Nhưng có cái này Tue_NV muốn hỏi bạn :

Đối tượng thì có nhiều loại đối tượng vậy bạn?

Bạn có thể cho biết là bạn thao tác với đối tượng nào không?

Hay là với các loại đối tượng?

- Nếu là với các loại đối tượng thì :

các đối tượng giao với đa tuyến kín có bị cắt xén đi không?

-Có lẽ rằng bạn nên tham khảo thêm Lisp xoá các đối tượng trong vùng kín.

Lisp đó rất hay và đáp ứng được yêu cầu của bạn

Bản thân Tue_NV ủng hộ ý kiến của bạn TrungNgaMY. Sử dụng hay không là quyền của bạn.

Cảm ơn bác Tue_NV nhiều.

Em post bài hơi bị lỗi vì không nói rõ hết mục đích của bài toán và không nói hết cách thức của bài toán mà mình sử dụng.

Thường em chủ yếu là thao tác với các đối tượng dạng điểm (block cũng là 1 đối tượng dạng điểm (điểm chuẩn)...). Em chỉ xét những điểm đó nằm trong, nằm trên hoặc nằm ngoài vùng được chọn. Nhưng sau khi đọc xong bài post của bác thì em lại có 1 ý kiến thêm, đó là thao tác với tất cả các đối tượng nhưng đường polyline sẽ không cắt, không đi qua các đối tượng được chọn. Nếu như đường polyline (vùng kín) cắt qua đối tượng được chọn thì sẽ hiển thị thông báo "Có chọn đối tượng bị cắt ngang qua hay không? "Như vậy vấn sẽ giải quyết được dễ dàng hơn. Mục đích của bài toán em xin được đính chính lại là " Chọn đối tượng trong vùng kín được lọc theo thuộc tính".

Thao tác của em như sau:

- Chọn polyline khép kín (Polyline hở sẽ thông báo "Vùng chưa khép kín" => chọn lại Polyline)

- Chọn đối tượng đã lọc thuộc tính để chọn. Hiển thị thông báo gợi ý đi kèm: "Đối tượng đã được lọc trong filters, nhấn "p" để chọn lại các đối tượng đó " . Cái này có thể là hơi thừa nhưng có ý nghĩa nhắc nhở lọc trước nếu ta quên

- Bạn chọn đối tượng nằm trong, trên hay ngoài vùng chọn => Thực hiện lệnh chọn đối tượng để tuỳ mình xử lý

(Nếu đối tượng được chọn bị cắt ngang qua thì hiển thị thông báo "Có chọn cả những đối tượng bị cắt ngang qua hay không ? )

Đó là cách thức em đưa ra đó bác có thấy hợp lý không? Nếu không hợp lý bác cho em ý kiến bác nhé. Rất mong ý kiến phản hồi từ bác và rất mong được bác ủng hộ để tạo ra lisp như vậy.

Một lần nữa cảm ơn bác

Tháng 8 15, 2010

Chào tất cả mọi người.
Sau khi trao đổi, vấn đề có vẻ rõ ràng hơn.

Tui xin đưa ra giải pháp khác : tạm gọi là Copy Block trong PLINE kín

B1. Xác định tọa độ của các đỉnh hình chử nhật bao quanh Pline

B2. Trong phạm vi hình chử nhật này, lần luợt duyệt qua các điểm theo qui luật cho trước (sắp xếp theo hình vuông, hình chử nhật hay hình thoi so le nhau ...)

- nếu điểm nằm trong PLine -> copy Block tới điểm đó.

Vấn đề bây giờ là cách xác định một điểm cho trước có nằm trong PLine(curve) hay không ?

Và làm sao thực hiện với thời gian chấp nhận được.

Xin giới thiệu LISP và ứng dụng .NET cùng thực hiện : Copy Block trong PLINE kín.

(2 ứng dụng này sắp xếp Block so le nhau)

Mời các bạn chạy thử và góp ý. Xin cảm ơn.

link download file : CopyBLOCK

to thanhduan2407 : nhớ đọc file Readme.

Em đã thực hiện cả 2 phần mềm mà bác viết. Rất tuyệt bác à. Tốc độ của .NET nhanh hơn rất nhiều. Cảm ơn bác.

Em vừa post 1 bài trên diễn đàn cũng trong chủ đề này. Rất mong bác tham gia ý kiến. Bài em gửi cho bác Tue_NV.

Các bác thật là rất tuyệt

Tháng 8 15, 2010

Chào tất cả mọi người.
Sau khi trao đổi, vấn đề có vẻ rõ ràng hơn.

Tui xin đưa ra giải pháp khác : tạm gọi là Copy Block trong PLINE kín

B1. Xác định tọa độ của các đỉnh hình chử nhật bao quanh Pline

B2. Trong phạm vi hình chử nhật này, lần luợt duyệt qua các điểm theo qui luật cho trước (sắp xếp theo hình vuông, hình chử nhật hay hình thoi so le nhau ...)

- nếu điểm nằm trong PLine -> copy Block tới điểm đó.

Vấn đề bây giờ là cách xác định một điểm cho trước có nằm trong PLine(curve) hay không ?

Và làm sao thực hiện với thời gian chấp nhận được.

Xin giới thiệu LISP và ứng dụng .NET cùng thực hiện : Copy Block trong PLINE kín.

(2 ứng dụng này sắp xếp Block so le nhau)

Mời các bạn chạy thử và góp ý. Xin cảm ơn.

link download file : CopyBLOCK

to thanhduan2407 : nhớ đọc file Readme.

Chào bác Gia_Bach.

Trước khi em ra ngoài có việc em lại mò vào phần của bác viết và thử lại thì rất hay nhưng sau khi thử vài trường hợp thì phần LISP vẫn còn bị lỗi, em đã thử lại rất nhiều lần bằng các hình dạng vùng khác nhau, về đa giác lồi thì chạy rất tốt nhưng về đa giác phức tạp 1 chút là chạy ra array bị sai. Bác có thể chỉnh sửa lại được không ạ. Về .NET thì rất tuyệt, nhanh và chính xác. Sau khi thử nghiệm cả 3 chương trình (2 của bác Gia_Bach và 1 của bác Tue_NV) thì em đưa ra kết quả sau:

http://www.4shared.com/file/Lo5LliH9/ARRAY_1_.html

Em không có ý so sánh để làm phật lòng bác, như bác nói Mời các bạn chạy thử và góp ý. Xin cảm ơn.

Cảm ơn bác rất nhiều. Bác viết phần mềm .NET rất hay, bác có thể cho em mã CODE được không ạ?

Nếu lập trình VBA thì hay biết mấy, bác gửi cho em bác nhé. Cảm ơn bác rất rất nhiều

Tháng 8 15, 2010

Cảm ơn bác Tue_NV nhiều.
Em post bài hơi bị lỗi vì không nói rõ hết mục đích của bài toán và không nói hết cách thức của bài toán mà mình sử dụng.

Thường em chủ yếu là thao tác với các đối tượng dạng điểm (block cũng là 1 đối tượng dạng điểm (điểm chuẩn)...). Em chỉ xét những điểm đó nằm trong, nằm trên hoặc nằm ngoài vùng được chọn. Nhưng sau khi đọc xong bài post của bác thì em lại có 1 ý kiến thêm, đó là thao tác với tất cả các đối tượng nhưng đường polyline sẽ không cắt, không đi qua các đối tượng được chọn. Nếu như đường polyline (vùng kín) cắt qua đối tượng được chọn thì sẽ hiển thị thông báo "Có chọn đối tượng bị cắt ngang qua hay không? "Như vậy vấn sẽ giải quyết được dễ dàng hơn. Mục đích của bài toán em xin được đính chính lại là " Chọn đối tượng trong vùng kín được lọc theo thuộc tính".

Thao tác của em như sau:

1- Chọn polyline khép kín (Polyline hở sẽ thông báo "Vùng chưa khép kín" => chọn lại Polyline)

2- Chọn đối tượng đã lọc thuộc tính để chọn. Hiển thị thông báo gợi ý đi kèm: "Đối tượng đã được lọc trong filters, nhấn "p" để chọn lại các đối tượng đó " . Cái này có thể là hơi thừa nhưng có ý nghĩa nhắc nhở lọc trước nếu ta quên

3- Bạn chọn đối tượng nằm trong, trên hay ngoài vùng chọn => Thực hiện lệnh chọn đối tượng để tuỳ mình xử lý

(Nếu đối tượng được chọn bị cắt ngang qua thì hiển thị thông báo "Có chọn cả những đối tượng bị cắt ngang qua hay không ? )

Đó là cách thức em đưa ra đó bác có thấy hợp lý không? Nếu không hợp lý bác cho em ý kiến bác nhé. Rất mong ý kiến phản hồi từ bác và rất mong được bác ủng hộ để tạo ra lisp như vậy.

Một lần nữa cảm ơn bác

Như vậy thì Lisp chỉ áp dụng với đối tượng dạng điểm như point, Block, Text, Mtext và Lisp xử lý nó theo điểm chèn phải không bạn?

Trong 3 thao tác của bạn thì Tue_NV thấy thao tác thứ 2 và thao tác thứ 3 : bạn làm không OK lắm

- Thao tác thứ 2 : Ngay ở dòng select object (khi thực thi Lisp), bạn muốn lọc thì Lisp lọc, bạn muốn chọn thì Lisp chọn, không cần thiết phải làm như ý của bạn vì không hiệu quả khi sử dụng vì như bạn nói : nó hơi thừa

- Thao tác thứ 3 : Bạn chọn đối tượng nằm trong, trên hay ngoài vùng chọn [/b] => Thực hiện lệnh chọn đối tượng để tuỳ mình xử lý

Đã là chọn Tren rồi thì có cần phải hỏi là "Có chọn cả những đối tượng bị cắt ngang qua hay không ?" Vì đã nằm trên rồi thì đương nhiên Polyline phải cắt qua chứ phải không bạn? Có thể là Tue_NV hiểu chưa được đúng. Bạn nói rõ hơn nhé.

Bổ sung thêm 1 ý nữa là Lisp có thể áp dụng cho Spline kín chứ không riêng gì Polyline

Tue_NV đang bận. Lúc rãnh mới có thể viết Lisp được

@Anh Duy : Tue_NV mới thấy bài của anh hôm qua, sao anh vội del đi thế?

Nếu anh thấy các hàm vl khó hiểu thì Tue_NV viết code này, không có sử dụng hàm vl, hy vọng anh Duy và bạn thanhDuan dễ hiểu hơn :

Đây là code :

(defun c:aic(/ oldos pl name kc minp maxp minpp from cur end ins fl)
 (command "undo" "be")
 (setvar "attreq" 0)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq pl (car(entsel "\n Pick chon Polyline kin :")))
 (setq name (getstring t "\n Nhap ten Block / Enter de chon Block :"))
 (if (= name "") (setq name (cdr(assoc 2 (entget (car(entsel "\n Pick chon Block :")))))))
 (setq kc (getdist "\n Nhap khoang cach :"))
 (setq minp (car (ACET-GEOM-EXTENTS pl)))
 (setq maxp (cadr (ACET-GEOM-EXTENTS pl)))
 (setq minpp (mapcar '- minp
	         (list (setq dist (distance maxp minp)) dist 0.0)
      )
 )
 (command "insert" name minp 1 1 0)
 (setq from (entlast) ss (ssadd))
 (command "array" "L" "" "R"
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   kc kc
 )
   (setq end (entlast) cur from)
(initget "N T")
 (setq ans (getkword "\n Ban muon xoa doi tuong Trong hay Ngoai duong bao  :"))
 (while (or fl (not (eq cur end)))
   (setq ins (cdr(assoc 10 (entget cur))))
   (command "line" minpp ins "")
   (if (= ans "N")
   	(if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 0)
     		(entdel cur)
       )
       (if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 1)
     		(entdel cur)
       )
   )
     (entdel (entlast))
(setq cur (entnext cur))
       (if (eq cur end) (progn (setq fl t) ;(setq cur end))		 
)
 )

 (command "undo" "end")
 (setvar "osmode" oldos)
)

Trong Code có sử dụng hàm (ACET-GEOM-EXTENTS ent) : hàm trả về điểm min và max của ent trong 1 list

Ví dụ : (ACET-GEOM-EXTENTS (car(entsel)))

Hàm (ACET-GEOM-INTERSECTWITH en1 en2 flag)

Hàm trả về listpoint tọa độ các điểm giao của 2 đối tượng en1 en2.

flag là số interger, cờ quy định các kiểu giao:

- 0: không mở rộng 2 đối tượng en1 en2

- 1: mở rộng đối tượng en1, không mở rộng đối tượng en2.

- 2: không mở rộng đối tượng en1, mở rộng đối tượng en2.

- 3: mở rộng 2 đối tượng en1 en2

Trong code trên thì Tue_NV đã sử dụng kiểu cờ flag=0

Các hàm này nằm trong phụ trợ Express

Tháng 8 15, 2010

Như vậy thì Lisp chỉ áp dụng với đối tượng dạng điểm như point, Block, Text, Mtext và Lisp xử lý nó theo điểm chèn phải không bạn?
Trong 3 thao tác của bạn thì Tue_NV thấy thao tác thứ 2 và thao tác thứ 3 : bạn làm không OK lắm

- Thao tác thứ 2 : Ngay ở dòng select object (khi thực thi Lisp), bạn muốn lọc thì Lisp lọc, bạn muốn chọn thì Lisp chọn, không cần thiết phải làm như ý của bạn vì không hiệu quả khi sử dụng vì như bạn nói : nó hơi thừa

- Thao tác thứ 3 : Bạn chọn đối tượng nằm trong, trên hay ngoài vùng chọn [/b] => Thực hiện lệnh chọn đối tượng để tuỳ mình xử lý

Đã là chọn Tren rồi thì có cần phải hỏi là "Có chọn cả những đối tượng bị cắt ngang qua hay không ?" Vì đã nằm trên rồi thì đương nhiên Polyline phải cắt qua chứ phải không bạn? Có thể là Tue_NV hiểu chưa được đúng. Bạn nói rõ hơn nhé.

Bổ sung thêm 1 ý nữa là Lisp có thể áp dụng cho Spline kín chứ không riêng gì Polyline

Tue_NV đang bận. Lúc rãnh mới có thể viết Lisp được

@Anh Duy : Tue_NV mới thấy bài của anh hôm qua, sao anh vội del đi thế?

Nếu anh thấy các hàm vl khó hiểu thì Tue_NV viết code này, không có sử dụng hàm vl, hy vọng anh Duy và bạn thanhDuan dễ hiểu hơn :

Đây là code :
(defun c:aic(/ oldos pl name kc minp maxp minpp from cur end ins fl)
 (command "undo" "be")
 (setvar "attreq" 0)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq pl (car(entsel "\n Pick chon Polyline kin :")))
 (setq name (getstring t "\n Nhap ten Block / Enter de chon Block :"))
 (if (= name "") (setq name (cdr(assoc 2 (entget (car(entsel "\n Pick chon Block :")))))))
 (setq kc (getdist "\n Nhap khoang cach :"))
 (setq minp (car (ACET-GEOM-EXTENTS pl)))
 (setq maxp (cadr (ACET-GEOM-EXTENTS pl)))
 (setq minpp (mapcar '- minp
	         (list (setq dist (distance maxp minp)) dist 0.0)
      )
 )
 (command "insert" name minp 1 1 0)
 (setq from (entlast) ss (ssadd))
 (command "array" "L" "" "R"
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   kc kc
 )
   (setq end (entlast) cur from)
(initget "N T")
 (setq ans (getkword "\n Ban muon xoa doi tuong Trong hay Ngoai duong bao < N / T > :"))
 (while (or fl (not (eq cur end)))
   (setq ins (cdr(assoc 10 (entget cur))))
   (command "line" minpp ins "")
   (if (= ans "N")
   	(if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 0)
     		(entdel cur)
       )
       (if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 1)
     		(entdel cur)
       )
   )
     (entdel (entlast))
(setq cur (entnext cur))
       (if (eq cur end) (progn (setq fl t) ;(setq cur end))		 
)
 )

 (command "undo" "end")
 (setvar "osmode" oldos)
)
Trong Code có sử dụng hàm (ACET-GEOM-EXTENTS ent) : hàm trả về điểm min và max của ent trong 1 list

Ví dụ : (ACET-GEOM-EXTENTS (car(entsel)))

Hàm (ACET-GEOM-INTERSECTWITH en1 en2 flag)

Hàm trả về listpoint tọa độ các điểm giao của 2 đối tượng en1 en2.

flag là số interger, cờ quy định các kiểu giao:

- 0: không mở rộng 2 đối tượng en1 en2

- 1: mở rộng đối tượng en1, không mở rộng đối tượng en2.

- 2: không mở rộng đối tượng en1, mở rộng đối tượng en2.

- 3: mở rộng 2 đối tượng en1 en2

Trong code trên thì Tue_NV đã sử dụng kiểu cờ flag=0

Các hàm này nằm trong phụ trợ Express

Cảm ơn bác Tue_NV rất nhiều, mặc dù bác rất bận nhưng vẫn tham gia góp ý kiến.

Đúng là thao tác thứ 3 của em hơi ko OK. Em xin đính chính lại là : Bạn chọn đối tượng nằm trong hay ngoài vùng chọn .

Cảm ơn bác nhiều vì đã thay hàm và giải thích rõ ràng. Lisp của bác chạy rất OK. Mong bác lúc nào rảnh có thể giải đáp được bài toán. Mong tin bác

Em muốn lấy tất cả các đối tượng được chọn, không phải chỉ dạng điểm (trường hợp cắt ngang qua thì xét riêng)

Em luôn lắng nghe và chờ đợi ý kiến phản hồi.

Tháng 8 15, 2010

Như vậy thì Lisp chỉ áp dụng với đối tượng dạng điểm như point, Block, Text, Mtext và Lisp xử lý nó theo điểm chèn phải không bạn?
Trong 3 thao tác của bạn thì Tue_NV thấy thao tác thứ 2 và thao tác thứ 3 : bạn làm không OK lắm

- Thao tác thứ 2 : Ngay ở dòng select object (khi thực thi Lisp), bạn muốn lọc thì Lisp lọc, bạn muốn chọn thì Lisp chọn, không cần thiết phải làm như ý của bạn vì không hiệu quả khi sử dụng vì như bạn nói : nó hơi thừa

- Thao tác thứ 3 : Bạn chọn đối tượng nằm trong, trên hay ngoài vùng chọn [/b] => Thực hiện lệnh chọn đối tượng để tuỳ mình xử lý

Đã là chọn Tren rồi thì có cần phải hỏi là "Có chọn cả những đối tượng bị cắt ngang qua hay không ?" Vì đã nằm trên rồi thì đương nhiên Polyline phải cắt qua chứ phải không bạn? Có thể là Tue_NV hiểu chưa được đúng. Bạn nói rõ hơn nhé.

Bổ sung thêm 1 ý nữa là Lisp có thể áp dụng cho Spline kín chứ không riêng gì Polyline

Tue_NV đang bận. Lúc rãnh mới có thể viết Lisp được

@Anh Duy : Tue_NV mới thấy bài của anh hôm qua, sao anh vội del đi thế?

Nếu anh thấy các hàm vl khó hiểu thì Tue_NV viết code này, không có sử dụng hàm vl, hy vọng anh Duy và bạn thanhDuan dễ hiểu hơn :

Đây là code :
(defun c:aic(/ oldos pl name kc minp maxp minpp from cur end ins fl)
 (command "undo" "be")
 (setvar "attreq" 0)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq pl (car(entsel "\n Pick chon Polyline kin :")))
 (setq name (getstring t "\n Nhap ten Block / Enter de chon Block :"))
 (if (= name "") (setq name (cdr(assoc 2 (entget (car(entsel "\n Pick chon Block :")))))))
 (setq kc (getdist "\n Nhap khoang cach :"))
 (setq minp (car (ACET-GEOM-EXTENTS pl)))
 (setq maxp (cadr (ACET-GEOM-EXTENTS pl)))
 (setq minpp (mapcar '- minp
	         (list (setq dist (distance maxp minp)) dist 0.0)
      )
 )
 (command "insert" name minp 1 1 0)
 (setq from (entlast) ss (ssadd))
 (command "array" "L" "" "R"
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   (1+ (fix (/ (- (car maxp) (car minp)) kc)))
   kc kc
 )
   (setq end (entlast) cur from)
(initget "N T")
 (setq ans (getkword "\n Ban muon xoa doi tuong Trong hay Ngoai duong bao < N / T > :"))
 (while (or fl (not (eq cur end)))
   (setq ins (cdr(assoc 10 (entget cur))))
   (command "line" minpp ins "")
   (if (= ans "N")
   	(if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 0)
     		(entdel cur)
       )
       (if (= (rem (length (ACET-GEOM-INTERSECTWITH (entlast) pl 0)) 2) 1)
     		(entdel cur)
       )
   )
     (entdel (entlast))
(setq cur (entnext cur))
       (if (eq cur end) (progn (setq fl t) ;(setq cur end))		 
)
 )

 (command "undo" "end")
 (setvar "osmode" oldos)
)
Trong Code có sử dụng hàm (ACET-GEOM-EXTENTS ent) : hàm trả về điểm min và max của ent trong 1 list

Ví dụ : (ACET-GEOM-EXTENTS (car(entsel)))

Hàm (ACET-GEOM-INTERSECTWITH en1 en2 flag)

Hàm trả về listpoint tọa độ các điểm giao của 2 đối tượng en1 en2.

flag là số interger, cờ quy định các kiểu giao:

- 0: không mở rộng 2 đối tượng en1 en2

- 1: mở rộng đối tượng en1, không mở rộng đối tượng en2.

- 2: không mở rộng đối tượng en1, mở rộng đối tượng en2.

- 3: mở rộng 2 đối tượng en1 en2

Trong code trên thì Tue_NV đã sử dụng kiểu cờ flag=0

Các hàm này nằm trong phụ trợ Express

Các đối tượng không nằm so le nhau và tốc độ chậm hơn so với lần trước bác Tue_NV à.

Nhưng em dễ hiểu hơn

Tháng 8 15, 2010

Các đối tượng không nằm so le nhau và tốc độ chậm hơn so với lần trước bác Tue_NV à.
Nhưng em dễ hiểu hơn

Tue_NV viết cho các đối tượng không nằm so le nhau là có chủ đích với cốt ý để cho anh Duy và bạn dễ hiểu đấy mà (để dễ thấy và nhận ra). Khi hiểu ra rồi thì cho viết cho trường hợp so le mấy hồi (đơn giản).

Về tốc độ thì các hàm Lisp không nhanh bằng Visual Lisp, vì thế Tue_NV thích sử dụng các hàm Vl hơn.

Tóm lại, Tue_NV viết lại yêu cầu bài toán của bạn, bạn xem có đúng không nhé:

Bài toán : Chọn 1 loạt đối tượng : Đối tượng chọn có thể lọc bằng lệnh filter hay bằng các phương pháp chọn. Muốn chọn kiểu nào thì có ngay kiểu đó. Chương trinhtự động lọc ra đối tượng nằm trong hay trên hay ngoài 1đường bao kín. Đường bao kín là 1 Polyline kín hoặc là 1 Spline kín. Đối tượng nằm trên đường bao (là đối tượng mà đường bao cắt qua)

OK không? :(

Bạn xem bài toán của bạn phát biểu như vầy, đúng không?

Đây là 1 bài toán hay và lời giải cho nó cũng chính là từ thuật toán mà bạn đã đưa ra. Hướng giải quyết là như vậy.

Tháng 8 15, 2010

Tue_NV viết cho các đối tượng không nằm so le nhau là có chủ đích với cốt ý để cho anh Duy và bạn dễ hiểu đấy mà (để dễ thấy và nhận ra). Khi hiểu ra rồi thì cho viết cho trường hợp so le mấy hồi (đơn giản).
Về tốc độ thì các hàm Lisp không nhanh bằng Visual Lisp, vì thế Tue_NV thích sử dụng các hàm Vl hơn.

Tóm lại, Tue_NV viết lại yêu cầu bài toán của bạn, bạn xem có đúng không nhé:

Bài toán : Chọn 1 loạt đối tượng : Đối tượng chọn có thể lọc bằng lệnh filter hay bằng các phương pháp chọn. Muốn chọn kiểu nào thì có ngay kiểu đó. Chương trinhtự động lọc ra đối tượng nằm trong hay trên hay ngoài 1đường bao kín. Đường bao kín là 1 Polyline kín hoặc là 1 Spline kín. Đối tượng nằm trên đường bao (là đối tượng mà đường bao cắt qua)

OK không? :(

Bạn xem bài toán của bạn phát biểu như vầy, đúng không?

Đây là 1 bài toán hay và lời giải cho nó cũng chính là từ thuật toán mà bạn đã đưa ra. Hướng giải quyết là như vậy.

Vâng. Bác Tue_NV nói ngắn gọn mà đầy đủ, yêu cầu đã được đặt ra đúng như vậy đó bác. Em hiểu Visual Lisp nhanh hơn lisp. Em mong sau này sẽ sử dụng linh hoạt và tạo ra những ứng dụng cần thiết. Cảm ơn bác nhiều. Em đã đăng ký trên diễn đàn lâu rồi nhưng dạo này em mới có thời gian để tìm tòi và học hỏi. Gần như ngày nào em cũng dạo qua diễn đàn để tìm những cái hay và đóng góp ý kiến. Được tham gia và trò chuyện với các bác trên đây em rất vui, cảm ơn tất cả, cảm ơn cadviet.com rất nhiều.

Tháng 8 15, 2010

Gần đây cũng có 1 anh bạn nhờ mình về bài toán này (hatch bằng block) nên cũng có theo dỏi và ý kiến chút chứ thật ra đến nay nhu cầu lisp cho công việc của mình đã dừng lại. Mà làm việc với danh sách thì mình tiêu hoá ko nổi. Miễn cưỡng thì đọc và copy cả 1 đọan của ng khác để làm 1 mục đích nào đó thì đc nhưng mình ko thích cho lắm nên Cái lisp trên của Tuệ thì nếu có nhu cầu mình vẩn chôm đc 1 đoạn. Còn hiểu cho mạch lạc thì chắc phải đọc thêm. Rất nể khả năng học của Tuệ vì hình như xuất phát điểm của mình và Tuệ cùng như nhau nhưng mình dừng lại rồi ko phát triển nửa bị ì rồi. :(

Tháng 8 16, 2010

Bác Tue_NV à.

Thay vì lisp tự chọn lấy một điểm gốc để array ta thay bằng cách kích chọn trực tiếp từ màn hình và em chỉ cần array theo hàng cột thôi chứ không cần theo kiểu so le như ví dụ em đã post từ đầu. Chả là trong cùng một vùng kín nhưng em muốn trải nhiều loại block xen kẽ nhau, nhưng nếu sử dụng được với lisp trên thì nó sẽ trùng đè nhau. Nếu với cách kích chọn từ màn hình thì sẽ dễ dàng hơn khi trải mảng. Với kiểu so le nhau thì em làm 2 lần (hơi nhiều nhưng ổn). Khi chọn đối tượng, chọn vị trí gốc (từ điểm đó mà trải mảng) sau đó sẽ hỏi khoảng cách hàng và khoảng cách cột. Mong bác phản hồi

Tháng 8 16, 2010

Bác Tue_NV à.
Thay vì lisp tự chọn lấy một điểm gốc để array ta thay bằng cách kích chọn trực tiếp từ màn hình và em chỉ cần array theo hàng cột thôi chứ không cần theo kiểu so le như ví dụ em đã post từ đầu. Chả là trong cùng một vùng kín nhưng em muốn trải nhiều loại block xen kẽ nhau, nhưng nếu sử dụng được với lisp trên thì nó sẽ trùng đè nhau. Nếu với cách kích chọn từ màn hình thì sẽ dễ dàng hơn khi trải mảng. Với kiểu so le nhau thì em làm 2 lần (hơi nhiều nhưng ổn). Khi chọn đối tượng, chọn vị trí gốc (từ điểm đó mà trải mảng) sau đó sẽ hỏi khoảng cách hàng và khoảng cách cột. Mong bác phản hồi

Điểm gốc mà Tue_NV sử dụng để aray chính là điểm min của đường bao. Cứ thế Array theo trục dương OX và trục dương OY.

Nếu bạn chọn điểm gốc để chèn thì không có vấn đề gì cả. Nhưng Lisp sẽ array đối tượng Block theo trục dương OX và trục dương OY tính từ điểm gốc và xử lý. Bạn muốn array theo kiểu nào? Hãy upload file và nói rõ hơn nhé

Tue_NV hỏi thêm là : Bạn trải nhiều Block xen kẽ nhau? Vậy thì nhiều loại Block là tối đa là bao nhiêu vậy bạn? Có nhiều hơn 2 loại Block không? hay là = 2

Bạn nói rõ ràng hơn thì mới viết được

Vậy nhé

Tháng 8 16, 2010

Điểm gốc mà Tue_NV sử dụng để aray chính là điểm min của đường bao. Cứ thế Array theo trục dương OX và trục dương OY.
Nếu bạn chọn điểm gốc để chèn thì không có vấn đề gì cả. Nhưng Lisp sẽ array đối tượng Block theo trục dương OX và trục dương OY tính từ điểm gốc và xử lý. Bạn muốn array theo kiểu nào? Hãy upload file và nói rõ hơn nhé

Vâng.

Bác xem file này nhé:

http://www.cadviet.com/upfiles/3/array_vi_tri_dat.dwg

Tháng 8 16, 2010

Vâng.
Bác xem file này nhé:

http://www.cadviet.com/upfiles/3/array_vi_tri_dat.dwg

Bạn thử cái này xem :

Lisp AIC

Tháng 8 16, 2010

Bạn thử cái này xem :
Lisp AIC

Bác thật tuyệt vời.

Cảm ơn bác rất nhiều. Chính xác 100%. Cảm ơn bác.

Bác xem hộ em qua phần chọn đối tượng trong vùng như bác đã diễn đạt bác nhé.

Một lần nữa cảm ơn bác.

Tháng 8 16, 2010

Bạn thử cái này xem :
Lisp AIC

Bác Tue_NV à!

Em có thể hỏi bác một chút được không?

Một số hàm vl-, vlax-.....em không biết tìm kiếm đâu để tra cứu.

Bác có thể send cho em cấu trúc các hàm đó và cách sử dụng được không?

Cụ thể một số hàm trong lisp bác viết như:

(setq ms (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))))

(setq pl (vlax-ename->vla-object (car(entsel "\n Chon Polyline kin :"))))

Ngoài ra còn hàm :

+ (setq minp (safearray-value minp))

+ (setq maxp (safearray-value maxp))

+ (setq line (vla-addline ms (vlax-3d-point minpp)

(vla-get-insertionpoint x)

+ (if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 0)

(vla-erase x)

Bác giải thích cho em các hàm trên bác nhé.

Mong rằng sau mỗi lần hiểu em sẽ vọc thêm được nhiều kiến thức hơn nữa. Cảm ơn bác

Tháng 8 17, 2010

............
Sau khi thử nghiệm cả 3 chương trình (2 của bác Gia_Bach và 1 của bác Tue_NV) thì em đưa ra kết quả sau:

http://www.4shared.com/file/Lo5LliH9/ARRAY_1_.html

Em không có ý so sánh để làm phật lòng bác, như bác nói Mời các bạn chạy thử và góp ý. Xin cảm ơn.

..........

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.

Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.

Bạn thử cái này xem :
Lisp AIC

Chào Tue_NV!

Lisp's level của Tue_NV cao quá trời.

Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :

Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)

Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool

VD :

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)

1. kiểm tra CAD có cài đặt Express Tool.

(setq Express (and (vl-position "acetutil.arx" (arx))

(not

(vl-catch-all-error-p

(vl-catch-all-apply

(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:

(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :

(foreach x ssa

(setq line (vla-addline ms (vlax-3d-point minpp)

(vla-get-insertionpoint x) ) )

; ...

;update thanh trang thai

(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :

(if Express (setq ProgBar (acet-ui-progress)))

Update LISP : Copy Block trong đuờng bao Pline kín.

(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
 ;| By : Gia Bach, gia_bach @  www.CadViet.com             |;  
 (vl-load-com)

 (defun *error* (msg)
   (and Express ProgBar (acet-ui-progress))
   (and ov (mapcar 'setvar vl ov))    
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq Express (and (vl-position "acetutil.arx" (arx))
	     (not
	       (vl-catch-all-error-p
		 (vl-catch-all-apply
		   (function (lambda nil (acet-sys-shift-down))))))))

 (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
       ov (mapcar 'getvar vl)) ; Get Old values  
 (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

 (or *dis* (setq *dis* 10))
 (initget 6)
 (setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
 (if dis (setq *dis* dis) (setq dis *dis*) )

 (setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
 (vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
 (setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

 (setq start (getvar "MILLISECS"))
 (if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

 (while (< (cadr pt) (cadr maxpt))
   (while (< (car pt) (car maxpt))
     (if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
     (setq pt (polar pt 0 dis)))
   (setq pt (polar minpt  (/ pi 2.0) (* i (/ dis 2)))
  i (1+ i) )
   (if (= (rem i 2)0)
     (setq pt (polar pt 0 (/ dis 2))))
   (if Express (acet-ui-progress -1)) )
 (if Express (setq ProgBar (acet-ui-progress)))

 (setq time (/ (- (getvar "MILLISECS") start) 1000.0))
 (princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
 (mapcar 'setvar vl ov)
 (princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
 (setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
 (if (equal ClosestPoint pt 1e-6)
   (setq flag nil)
   (progn
     (setq flag (and (setq int (vlax-invoke
			  (setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
			  'IntersectWith Obj 0))
	      (= (rem (length int) 2) 1)) )
     (vla-delete lin)) )
 flag)

Tháng 8 17, 2010

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.
Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.

Chào Tue_NV!

Lisp's level của Tue_NV cao quá trời.

Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :

Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)

Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool

VD :

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)

1. kiểm tra CAD có cài đặt Express Tool.

(setq Express (and (vl-position "acetutil.arx" (arx))

(not

(vl-catch-all-error-p

(vl-catch-all-apply

(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:

(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :

(foreach x ssa

(setq line (vla-addline ms (vlax-3d-point minpp)

(vla-get-insertionpoint x) ) )

; ...

;update thanh trang thai

(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :

(if Express (setq ProgBar (acet-ui-progress)))

Update LISP : Copy Block trong đuờng bao Pline kín.
(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
 ;| By : Gia Bach, gia_bach @  www.CadViet.com             |;  
 (vl-load-com)

 (defun *error* (msg)
   (and Express ProgBar (acet-ui-progress))
   (and ov (mapcar 'setvar vl ov))    
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq Express (and (vl-position "acetutil.arx" (arx))
	     (not
	       (vl-catch-all-error-p
		 (vl-catch-all-apply
		   (function (lambda nil (acet-sys-shift-down))))))))

 (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
       ov (mapcar 'getvar vl)) ; Get Old values  
 (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

 (or *dis* (setq *dis* 10))
 (initget 6)
 (setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
 (if dis (setq *dis* dis) (setq dis *dis*) )

 (setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
 (vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
 (setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

 (setq start (getvar "MILLISECS"))
 (if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

 (while (< (cadr pt) (cadr maxpt))
   (while (< (car pt) (car maxpt))
     (if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
     (setq pt (polar pt 0 dis)))
   (setq pt (polar minpt  (/ pi 2.0) (* i (/ dis 2)))
  i (1+ i) )
   (if (= (rem i 2)0)
     (setq pt (polar pt 0 (/ dis 2))))
   (if Express (acet-ui-progress -1)) )
 (if Express (setq ProgBar (acet-ui-progress)))

 (setq time (/ (- (getvar "MILLISECS") start) 1000.0))
 (princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
 (mapcar 'setvar vl ov)
 (princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
 (setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
 (if (equal ClosestPoint pt 1e-6)
   (setq flag nil)
   (progn
     (setq flag (and (setq int (vlax-invoke
			  (setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
			  'IntersectWith Obj 0))
	      (= (rem (length int) 2) 1)) )
     (vla-delete lin)) )
 flag)

Cảm ơn bác Gia_Bach rất nhiều. Lisp của bác chạy rất ổn và thêm một phần trực quan khi chương trình đang chạy (tránh tình trạng nghĩ máy bị đơ).

Cám ơn bác nhiều.

Đến khi nào em mới được bằng các bác đây. Em sẽ cố gắng học hỏi, mong các bác giúp đỡ. Cảm ơn các bác rất nhiều

Tháng 8 19, 2010

Bạn thử cái này xem :
Lisp AIC

Sau khi thành công trong việc array trong vùng kín của bác, em rất vui và càng cảm thấy hăng say tham gia vào diến đàn tìm kiếm cái mới. Mong bác Tue_NV lúc nào rảnh thì xem qua bài viết của em đã gửi cho bác vì em chờ đợi câu trả lời của bác từng ngày. Em nghĩ là bác bận nên chưa thể ghé qua thăm diễn đàn. Mong bác ghé thăm. Cảm ơn bác rất nhiều.

Vấn đề của em vẫn là chọn những đối tượng được lọc trước trong vùng kín mà bác đã từng nêu .

Tháng 8 20, 2010

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.
Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.

Chào Tue_NV!

Lisp's level của Tue_NV cao quá trời.

Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :

Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)

Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool

VD :

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)

1. kiểm tra CAD có cài đặt Express Tool.

(setq Express (and (vl-position "acetutil.arx" (arx))

(not

(vl-catch-all-error-p

(vl-catch-all-apply

(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:

(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :

(foreach x ssa

(setq line (vla-addline ms (vlax-3d-point minpp)

(vla-get-insertionpoint x) ) )

; ...

;update thanh trang thai

(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :

(if Express (setq ProgBar (acet-ui-progress)))

Update LISP : Copy Block trong đuờng bao Pline kín.
(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
 ;| By : Gia Bach, gia_bach @  www.CadViet.com             |;  
 (vl-load-com)

 (defun *error* (msg)
   (and Express ProgBar (acet-ui-progress))
   (and ov (mapcar 'setvar vl ov))    
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq Express (and (vl-position "acetutil.arx" (arx))
	     (not
	       (vl-catch-all-error-p
		 (vl-catch-all-apply
		   (function (lambda nil (acet-sys-shift-down))))))))

 (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
       ov (mapcar 'getvar vl)) ; Get Old values  
 (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

 (or *dis* (setq *dis* 10))
 (initget 6)
 (setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
 (if dis (setq *dis* dis) (setq dis *dis*) )

 (setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
 (vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
 (setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

 (setq start (getvar "MILLISECS"))
 (if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

 (while (< (cadr pt) (cadr maxpt))
   (while (< (car pt) (car maxpt))
     (if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
     (setq pt (polar pt 0 dis)))
   (setq pt (polar minpt  (/ pi 2.0) (* i (/ dis 2)))
  i (1+ i) )
   (if (= (rem i 2)0)
     (setq pt (polar pt 0 (/ dis 2))))
   (if Express (acet-ui-progress -1)) )
 (if Express (setq ProgBar (acet-ui-progress)))

 (setq time (/ (- (getvar "MILLISECS") start) 1000.0))
 (princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
 (mapcar 'setvar vl ov)
 (princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
 (setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
 (if (equal ClosestPoint pt 1e-6)
   (setq flag nil)
   (progn
     (setq flag (and (setq int (vlax-invoke
			  (setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
			  'IntersectWith Obj 0))
	      (= (rem (length int) 2) 1)) )
     (vla-delete lin)) )
 flag)

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!

Tháng 8 20, 2010

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!

cám ơn thiep.

do yêu cầu của thanhduan2407, lisp chỉ quan tâm đến điểm chèn của Block (Insert Point), nên có hiện tuợng như thiep đã đề cập.

Đúng như đề nghị của thiep , để khắc phục cần cập nhật hàm insidep với đ/kiện là xét giao giữa đuờng bao của Block với Curve.

Chúc bác mạnh khỏe, và thuờng xuyên ghé Cadviêt giúp mọi nguời. :D

Tháng 8 25, 2010

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!

Kết quả sai trong trường hợp đường cong có arc cho dù đường cong lồi hay lõm.

Thực ra lỗi là ở hàm vla-GetBoundingBox

Nếu đường cong có arc thì (x, y,z) của minpt nhỏ hơn (x, y,z) tương ứng của BoundingBox chính xác 1.e8

tương tự (x, y,z) của maxpt lớn hơn (x, y,z) của BoundingBox chính xác 1.e8

từ đó suy ra hàm IntersectWith cũng sai vì thực sự trong không gian LINE có z=1e-8 sẽ không cắt đường cong.

Vì vậy ta bỏ thành phần z của minpt và maxpt là được.

Tìm đến dòng

	(setq minpt (vlax-safearray->list minpt) 
maxpt (vlax-safearray->list maxpt) maxpt

Sửa thành

	(setq minpt (vlax-safearray->list minpt) minpt (list (car minpt) (cadr minpt))
maxpt (vlax-safearray->list maxpt) maxpt (list (car maxpt) (cadr maxpt))

Tháng 8 25, 2010

Bài toán : Chọn 1 loạt đối tượng : Đối tượng chọn có thể lọc bằng lệnh filter hay bằng các phương pháp chọn. Muốn chọn kiểu nào thì có ngay kiểu đó. Chương trinhtự động lọc ra đối tượng nằm trong hay trên hay ngoài 1đường bao kín. Đường bao kín là 1 Polyline kín hoặc là 1 Spline kín. Đối tượng nằm trên đường bao (là đối tượng mà đường bao cắt qua)
OK không? :D

Xin lỗi đã để thanhDuan phải đợi lâu.

Sau đây là lời giải cho bài toán này :


(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
	sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver) 
(PROGN
 (vl-load-com)
 (defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
 (defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
 (defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
 )
 (defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
 )
 (defun checkClosed(/ OK)
   (while (and (null OK) (setq pl (vlax-ename->vla-object
				(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0)))  )
         (if (null (vlax-curve-isClosed pl) )
       (progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
       (setq OK T)
 )
   )
pl
 )
 (acet-undo-begin)

 (setq oldos (getvar "osmode"))
 (setq ms (vla-get-modelspace 
	(setq doc (vla-get-activedocument
			(vlax-get-acad-object)
		  )
	)
   )
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
 )

 (prompt "\n Chon cac doi tuong :")
 (vla-SelectOnScreen ss)
 (iF (> (vla-get-count ss) 0)
   (proGN
 	(setq i 0)
 	(setq temperr *error*) 
 	(setq *error* bloi)
	(minmaxp (checkClosed) )
 	(setq minpp (mapcar '- (safearray-value minp)
		 	(list (setq dist (distance (safearray-value maxp) (safearray-value minp))) 
					dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
 	(setvar "osmode" 0)
 	(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while ( 		 (minmaxp (setq obj (vla-item ss i)))
 		(setq line (vla-addline ms minp maxp ))
 		(setq line2 (vla-addline ms 
			(vla-polarpoint util minp 0 
				(- (car (safearray-value maxp)) (car (safearray-value minp)) )
			)
			(vla-polarpoint util minp (/ pi 2) 
				(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
			)
    		 )
 		)
 ;
 		(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
   		(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
     			)
  		(PROGN
		(setq sslistints (cons obj sslistints))
  		)
  		(PROGN
       		(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
		(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
			(setq sslistous (cons obj sslistous))
			(setq sslistins (cons obj sslistins))
		)
		(vla-erase line3)
  		)
 		);if
	(setq i (1+ i))
	(vla-erase line)
	(vla-erase line2)
	(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
	((= ans "TRONG") (setq sss (getss sslistins)))
	((= ans "TREN") (setq sss (getss sslistints)))
	((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)	
(sssetfirst sss sss)
(setq *error* temperr)

    );proGN
(alert "\n No Selected....")
  );iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé :D

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi ạ.

Tue_NV đã bẩy được cái lỗi tắt chế độ bắt điểm nhưng chưa thành công trong việc trả về trạng thái "ban đầu" của ProgBar ạ. Nhờ anh gia_bach hướng dẫn giúp ạ.

Cảm ơn anh. :D

Tháng 8 25, 2010

Xin lỗi đã để thanhDuan phải đợi lâu.

Sau đây là lời giải cho bài toán này :


(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
	sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver) 
(PROGN
 (vl-load-com)
 (defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
 (defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
 (defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
 )
 (defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
 )
 (defun checkClosed(/ OK)
   (while (and (null OK) (setq pl (vlax-ename->vla-object
				(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0)))  )
         (if (null (vlax-curve-isClosed pl) )
       (progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
       (setq OK T)
 )
   )
pl
 )
 (acet-undo-begin)

 (setq oldos (getvar "osmode"))
 (setq ms (vla-get-modelspace 
	(setq doc (vla-get-activedocument
			(vlax-get-acad-object)
		  )
	)
   )
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
 )

 (prompt "\n Chon cac doi tuong :")
 (vla-SelectOnScreen ss)
 (iF (> (vla-get-count ss) 0)
   (proGN
 	(setq i 0)
 	(setq temperr *error*) 
 	(setq *error* bloi)
	(minmaxp (checkClosed) )
 	(setq minpp (mapcar '- (safearray-value minp)
		 	(list (setq dist (distance (safearray-value maxp) (safearray-value minp))) 
					dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
 	(setvar "osmode" 0)
 	(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while (< i (vla-get-count ss))
		 (minmaxp (setq obj (vla-item ss i)))
 		(setq line (vla-addline ms minp maxp ))
 		(setq line2 (vla-addline ms 
			(vla-polarpoint util minp 0 
				(- (car (safearray-value maxp)) (car (safearray-value minp)) )
			)
			(vla-polarpoint util minp (/ pi 2) 
				(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
			)
    		 )
 		)
 ;
 		(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
   		(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
     			)
  		(PROGN
		(setq sslistints (cons obj sslistints))
  		)
  		(PROGN
       		(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
		(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
			(setq sslistous (cons obj sslistous))
			(setq sslistins (cons obj sslistins))
		)
		(vla-erase line3)
  		)
 		);if
	(setq i (1+ i))
	(vla-erase line)
	(vla-erase line2)
	(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
	((= ans "TRONG") (setq sss (getss sslistins)))
	((= ans "TREN") (setq sss (getss sslistints)))
	((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)	
(sssetfirst sss sss)
(setq *error* temperr)

    );proGN
(alert "\n No Selected....")
  );iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé :D

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi ạ.

Tue_NV đã bẩy được cái lỗi tắt chế độ bắt điểm nhưng chưa thành công trong việc trả về trạng thái "ban đầu" của ProgBar ạ. Nhờ anh gia_bach hướng dẫn giúp ạ.

Cảm ơn anh. :D

Cảm ơn bác Tue_NV rất nhiều. Em lúc nào cũng mong ngóng chờ đợi tin của bác. Hiện tại em đang dùng máy của bạn để xem mà không có cài Cad nên chưa thử nghiệm được. Em cảm ơn bác rất nhiều vì đã tâm huyết với đề tài này. Dạ vâng, 'fi (dùng dấu nháy đơn để chèn lệnh khác vào) cái đó em cũng đã tìm hiểu rồi bác à. Cảm ơn bác đã nhắc nhở. Em sẽ reply lại cho bác khi thử nghiệm chương trình. Chúc bác vui vẻ và có nhiều đóng góp cho diễn đàn. Trân trọng

Đăng nhập

Array đối tượng trong vùng

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

thanhduan2407 272

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

Tue_NV 3.912

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

thanhduan2407 272

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

thanhduan2407 272

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

thanhduan2407 272

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

Tue_NV 3.912

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

thanhduan2407 272

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

thanhduan2407 272

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

Tue_NV 3.912

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

thanhduan2407 272

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

duy782006 1.545

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

thanhduan2407 272

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

Tue_NV 3.912

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

thanhduan2407 272

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

Tue_NV 3.912

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

thanhduan2407 272

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

thanhduan2407 272

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

gia_bach 1.549

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

thanhduan2407 272

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

thanhduan2407 272