[Yêu Cầu] Tách Khung Và Đối Tượng Trong Khung Đó Ra Thành Các Bản Vẽ Riếng Biệt

[conghoa 125]

Mình có bản vẽ với nhiều khung, khung lại có dạng block và polyline. Mình muốn nhờ các bạn làm giúp một lisp để tách Khung và đối tượng trong khung đó ra thành các bản vẽ riếng biệt.

 

Mô tả:

- Chạy lisp

- Chọn các khung muốn tách thành bản vẽ riêng biệt (Chọn Polyline1,2 và Block1 như hình dưới)

- Lisp sẽ tự động tách khung có đường polyline1, polyline2, block1 cùng các đối tượng bên trong khung thành các bản vẽ có đường dẫn theo đường dẫn file gốc hiện hành. Tên file mới có thể là: "tên file gốc + số thứ tự tăng dần)

 

Hình mô tả

 

File gốc

http://www.cadviet.com/upfiles/5/1969_wblock_multi.dwg

 

File mong muốn

http://www.cadviet.com/upfiles/5/1969_wblock_multi1.dwg

http://www.cadviet.com/upfiles/5/1969_wblock_multi2.dwg

http://www.cadviet.com/upfiles/5/1969_wblock_multi3.dwg

 

Cảm ơn các bạn đã giúp đỡ.

Trân trọng!

[Tr.CongSon 42]

A cho e hỏi: Có phải các Polyline1,2 là 1 layer riêng biệt là layer 3 block1 có tên là khung ko ạ.

Nếu vậy thì Khi chạy lisp thì chỉ cần chọn vùng chứa các  Polyline1,2 và Block1 ni là được,chứ không cần phải pick chọn từng đối tượng 1 :)

Tối ni em code thử xem sao :)

[conghoa 125]

A cho e hỏi: Có phải các Polyline1,2 là 1 layer riêng biệt là layer 3 block1 có tên là khung ko ạ.

Nếu vậy thì Khi chạy lisp thì chỉ cần chọn vùng chứa các  Polyline1,2 và Block1 ni là được,chứ không cần phải pick chọn từng đối tượng 1 :)

Tối ni em code thử xem sao :)

Mình chỉ làm ví dụ hình như thế, còn các polyline có thể nằm ở các layer khác nhau. Tên block cũng có thể thay đổi tùy theo bản vẽ. :) không biết yêu cầu hơi mở thế có làm được không :D

[Tr.CongSon 42]

Mình chỉ làm ví dụ hình như thế, còn các polyline có thể nằm ở các layer khác nhau. Tên block cũng có thể thay đổi tùy theo bản vẽ. :) không biết yêu cầu hơi mở thế có làm được không :D

Em làm được nhưng phải pick = tay ạ,chứ không quét chọn hàng loạt được ^^

Nếu muốn chọn hàng loạt thì nên thay đổi polyline và block đó sang 1 layer  riêng thì dễ hơn ạ :)

[Tr.CongSon 42]

Đã Code xong cho anh rồi đây :)

Có chỗ nào cần khắc phục thì anh chị cho ý kiến nhé.hi

 

(defun c:TBV (/ curfname curpath fname k_mau ll osm somax ssent strf strso ur x)
(grtext
-1
"CT T\U+00E1ch nhanh b\U+1EA3n v\U+1EBD ...!!! @ Tr\U+1EA7n C\U+00F4ng S\U+01A1n-Detail"
)
(defun TS:Max_numb (/ fnamelst lstso)
(if
(setq fnamelst (vl-remove curfname (vl-directory-files curpath (strcat fname "*.dwg"))))
(setq lstso (mapcar '(lambda (x / strf strso)
(setq strf (strlen fname)
strso (atoi (substr x (1+ strf) (- (strlen x) strf 4)))
)
)
fnamelst
)
)
(setq lstso (list 0))
)
(1+ (apply 'max lstso))
)
(defun _sel (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Pline or Block \U+0111\U+1EC3 t\U+00E1ch b\U+1EA3n v\U+1EBD : "))
(cond
((= 7 (getvar 'errno)) (princ "\nMissed, try again."))
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"LWPOLYLINE,INSERT"
)
(progn (setq ent (car ent))
nil
)
(princ "\nInvalid object selected.")
)
)
)
)
)
ent
)

;;;------------MAIN FUNCTION-------------
(setvar "cmdecho" 0)
(setq osm (getvar "OSMODE")
curpath (getvar "DWGPREFIX")
curfname (getvar "DWGNAME")
fname (vl-filename-base curfname)
somax 0
)
(setvar "osmode" 0)
(while
(setq k_mau (_sel))
(progn
(vla-getboundingbox (vlax-ename->vla-object k_mau) 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur)
)
(command ".zoom" "o" k_mau "")
(setq ssent (ssget "w" ll ur)
somax (itoa (TS:Max_numb))
)
(command "_.wblock" (strcat curpath fname somax ".dwg") "" ll ssent "")
(command "_.oops")
)
)
(command ".zoom" "e")
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(princ)
)

[conghoa 125]

Thanks em nhiều, như thế này cũng tốt đối với anh lắm rồi :)