Nhờ viết Lisp Hatch vùng kín của các đối tượng giao nhau.

[huaductiep 2]

Vì em hay phải Hatch nhiều vùng rất nhỏ mà mất công. Nên em có yêu cầu này hơi kì cục như trong file Cad bên dưới như sau: em có các đối tượng giao nhau gồm Line, Pline, Spline, Circle, Rectangular...v.v…Nay em nhờ các bác viết giúp em cái Lisp với nội dung như sau:

+ B1: Gõ lệnh “HatchKin”

+ B2: Chọn các đối tượng giao nhau cần Hatch.

+ B3: Enter để nhận được kết quả là các Vùng Hatch riêng biệt được tạo ra ở các vùng kín được tạo thành bởi các phần giao nhau của các đối tượng được lựa chọn trên.

Chú ý: Các Vùng Hatch này chứa các đối tượng Hatch riêng biệt (tức có tùy chọn Create Separate Hatches và Associative kèm theo), các đối tượng Hatch này tạo ra thuộc Layer hiện hành, Hatch Pattern Palette hiện hành, Scale, Angle của Hatch hiện hành, và có thêm cả Option Associative và Create Separate Hatches. Nói chung đối tượng Hatch hiện hành như thế nào thì vùng Hatch được tạo ra đều có các thuộc tính như vậy. 
Em xin chân thành cám ơn các bác :)

http://www.cadviet.com/upfiles/3/64997_test_hatch_1.dwg

[Doan Van Ha 3.191]

Một câu hỏi vừa hay vừa dỡ. Xét hình đầu tiên chẳng hạn:

Lý do gì để 4 vùng được hatch còn 3 vùng thì không?

Trong lúc đó 4 vùng được hatch là giao của 3 hình, và 3 vùng không hatch cũng là giao của 3 hình?

[huaductiep 2]

Hề hề. Em hnay đi cả ngày giờ mới lên để comment lại bài bác được. Cám ơn bác Doan Van Ha đã quan tâm tới em. Cái này chắc là do em sơ suất bỏ sót quên ko Hatch. Bác thông cảm giúp em nhá  :D 
Em gửi lại hình và cả file Cad (bên trên), bác xem lại giúp em với nhé.

Một câu hỏi vừa hay vừa dỡ. Xét hình đầu tiên chẳng hạn:

Lý do gì để 4 vùng được hatch còn 3 vùng thì không?

Trong lúc đó 4 vùng được hatch là giao của 3 hình, và 3 vùng không hatch cũng là giao của 3 hình?

[huaductiep 2]

hj. Yêu cầu của em chắc hơi kỳ quái. Nhưng nó cũng rất thiết thực. Em mong các bác trên Diễn Đàn giúp em với nha  :)

Em xin cám ơn ah ^^

[Doan Van Ha 3.191]

Không kỳ quái. Thậm chí rất hay. Nhưng để tìm được thuật toán thì không phải dễ (ít nhất là đối với tôi).

Ai đã nghĩ ra cách thì hãy giúp bạn ấy với.

Tôi chỉ mới le lói, nhưng nếu bạn kiên nhẩn chờ đợi thì khả dĩ, còn hối thúc thì không có thời gian.

[huaductiep 2]

hj. Các bác quan tâm là tốt lắm rồi. Chắc nó đang gây khó dễ cho các bác rồi. Các bác nghĩ được sớm thì tốt. Còn ko được thì coi như cái công việc đợt này em làm thủ công tiếp. Em đợi tin vui của các bác. Chỉ mong các bác viết được cái này chắc sẽ hữu ích cho nhiều việc  :)

[doanduyhung 40]

dể lắm bạn đây là code sreach từ google:

;Create regions in a grid of lines

 

(defun c:intlines2regions ( / *error* ms ss i lst )

(vl-load-com)

(or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))

(setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))

(vla-startundomark acDoc)

 

(defun *error* (msg)

(and

msg

(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))

(princ (strcat "\nError: " msg))

)

(vla-endundomark acDoc)

(princ)

)

 

(if

(setq ss (ssget '((0 . "LINE"))))

(progn

(repeat (setq i (sslength ss))

(setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))

)

(vlax-invoke ms 'AddRegion lst)

)

(princ "\nEmpty selection...Try again...")

)

(vla-endundomark acDoc)

(princ)

)

;;;;;;;;;;;;;;;;

code tren là tạo region từ nhiều line, mình có thể mở rộng chọn polyline, circle, arc, ... hình gì cũng được. Sau đó chuyển các hình này về các line nối nhau liên tục rồi dùng code trên để tạo nhiều region vùng giao nhau, khi có region rồi, bung ra region ra thành nhiều line để joint lại thành polyline, có polyline tương ứng với từng region thì entmake hatch là xong

chúc bạn thành công

[Doan Van Ha 3.191]

Dễ vô cùng!

[hiepttr 538]

Nhiều chuyện tí:

Tại sao ko đi:

Region ->>> Hatch

Mà đi:

Region ->>> Line ->>> Polyline ->>> Hatch

???

:mellow:

[Doan Van Ha 3.191]

@Doanduyhung+Hiepttr:

Cho 1 tập LINE giao nhau loạn xà ngầu. Cách gì để region chúng được vậy (mỗi vùng kín là 1 region)?

[doanduyhung 40]

-nó tự tìm vùng giao line để tạo region thôi, luu y có cả region tổng các vùng nhỏ

-lisp xử lý region thì ít nên có thể chuyển qua polyline để xử lý dể hơn

[Doan Van Ha 3.191]

-nó tự tìm vùng giao line để tạo region thôi, luu y có cả region tổng các vùng nhỏ

-lisp xử lý region thì ít nên có thể chuyển qua polyline để xử lý dể hơn

Bạn đã thử test chỗ màu đỏ chưa? Tôi test không được.

[ndtnv 481]

Dùng lisp BreakAll để tạo cắt thành các đối tượng nhỏ trước là được. Nếu chọn nhiều vùng rời nhau thì có nhiều region tổng.

Sau đó Hatch các Region như Hiepttr đề nghị

[Doan Van Ha 3.191]

Dùng lisp BreakAll để tạo cắt thành các đối tượng nhỏ trước là được. Nếu chọn nhiều vùng rời nhau thì có nhiều region tổng.

Sau đó Hatch các Region như Hiepttr đề nghị

Có cắt rời thì cũng không thể tạo các region không chồng lấn nhau. Cái khó của bài toán nó nằm ở đây.

[ndtnv 481]

Có cắt rời thì cũng không thể tạo các region không chồng lấn nhau. Cái khó của bài toán nó nằm ở đây.

Xét giao của 1 region với các region khác, nếu diện tích <> 0 thì loại region có diện tích lớn

[Tue_NV 3.912]

Xét giao của 1 region với các region khác, nếu diện tích <> 0 thì loại region có diện tích lớn

 

Bác hãy thử với tất cả các hình trong bản vẽ của bạn chủ topic sẽ biết ^_^

Có TH tạo được, có TH không tạo được như ý của bác

=> Bài toán nên đi theo phương án khác..........

[ndtnv 481]

Mình kiểm tra thì thấy lỗi là do lệnh trong breakall, các đối tượng tạo ra không đúng ngay vị trí giao
Trong file breakall.lsp, sửa 0.00001 => 1.e-10 ra kết quả OK với những đối tượng đã break

[doanduyhung 40]

Mọi người test nhé

(defun LM:Intersections ( obj1 obj2 mode / l r )
    (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)
(defun LM:IntersectionsInSet ( ss / a b i j l )
    (repeat (setq i (sslength ss))
        (setq a (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (repeat (setq j i)
            (setq b (vlax-ename->vla-object (ssname ss (setq j (1- j))))
                  l (cons (LM:Intersections a b acextendnone) l)
            )
        )
    )
    (apply 'append (reverse l))
)
(defun DDH:pointtolsppoint (pointchen lsppointchen / vitrichen ii)
  (setq iii 0)
  (repeat (- (length lsppointchen) 1)
    (if (and (> (distance pointchen (nth (+ iii 1) lsppointchen)) 0.001)
	     (> (distance pointchen (nth iii lsppointchen)) 0.001)
	     )
      (progn
	(if (<= (abs (- (distance (nth iii lsppointchen) (nth (+ iii 1) lsppointchen))
			(+ (distance pointchen (nth (+ iii 1) lsppointchen))
			   (distance pointchen (nth iii lsppointchen))
			   )
			))
		     0.001)
	  (setq vitrichen (+ iii 1))
	  )
	)
      )
    (setq iii (+ iii 1))
    )
  (setq lsppointchen (LM:InsertNth pointchen vitrichen lsppointchen))
  )
(defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
)
(defun LM:InsertNth ( x n l )
  ((lambda ( k )
     (apply 'append
	    (mapcar '(lambda ( a ) (if (= n (setq k (1+ k))) (list x a) (list a))) l)
	    )
     )
    -1
    )
  )
(defun entmakex-hatchvatlieu (Lsp layer mau kihieuhatch)  
 (entmakex
  (apply 'append
   (list (list '(0 . "HATCH")
	       '(100 . "AcDbEntity")
	       '(410 . "Model")
	       '(100 . "AcDbHatch")
	       '(10 0.0 0.0 0.0)
	       '(210 0.0 0.0 1.0)
	       (cons 2 kihieuhatch)
	       '(70 . 1)
	       '(71 . 0)
	       (cons 91 (length Lsp))
	       (cons 8 layer)
	       (cons 62 mau)
	       )
	 (apply 'append
		(mapcar '(lambda (a)
			   (apply 'append
				  (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
					(mapcar '(lambda (b) (cons 10 b)) a)
					'((97 . 0))))) Lsp))
	 '((75 . 0)
	   (76 . 1)
	   (47 . 1.)
	   (98 . 2)
	   (10 0. 0. 0.0)
	   (10 0. 0. 0.0)
	   (451 . 0)
	   (460 . 0.0)
	   (461 . 0.0)
	   (452 . 1)
	   (462 . 1.0)
	   (453 . 2)
	   (463 . 0.0)
	   (463 . 1.0)
	   (470 . "LINEAR")
	   )
	 )
	 )
  )
)
(defun create_layer (Layer  Color)
  (if (not (tblsearch "Layer" Layer))
    (entmakex
      (list
	(cons 0 "LAYER")
	(cons 100 "AcDbSymbolTableRecord")
	(cons 100 "AcDbLayerTableRecord")
	(cons 70 0)
	(cons 2 Layer)
	(cons 62 Color)
	)
      )
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:taovungpolylinekin(/)
  (vl-load-com)
  (princ "\nChon Cac Line, Polyline, Arc, Circle, Spline Hoac Ellipse De Tao Polyline Kin")
  (if (setq chonlinepolyline (ssget '((-4 . "<OR")(0 . "LINE")(0 . "CIRCLE")(0 . "SPLINE")(0 . "ARC")(0 . "ELLIPSE")(0 . "*POLYLINE")(-4 . "OR>"))))
    (progn
      (create_layer "PoLyline Tao Vung Kin" 3)      
      (setq lsplinepolyline nil)
      (setq i 0)
      (repeat (sslength chonlinepolyline)
	(setq lsplinepolyline (append lsplinepolyline (list (ACET-GEOM-OBJECT-POINT-LIST (ssname chonlinepolyline i) 1e-3))))	
	(setq i (+ i 1))
	)
      (setq lspgiaodiem (LM:IntersectionsInSet chonlinepolyline))
      (setq i 0)
      (foreach lsptungline lsplinepolyline
	(foreach diemgiao lspgiaodiem
	  (setq lsptungline (DDH:pointtolsppoint diemgiao lsptungline))
	  )
	(setq lsplinepolyline (LM:SubstNth lsptungline i lsplinepolyline))
	(setq i (+ i 1))
	)
      (setq lsptongline nil)
      (foreach lsptunglinepolyline lsplinepolyline
	(setq i 0)
	(repeat (- (length lsptunglinepolyline) 1)
	  (entmakex (list  '(0 . "LINE")
			   (cons 10 (list (car (nth i lsptunglinepolyline)) (cadr (nth i lsptunglinepolyline))))
			   (cons 11 (list (car (nth (+ i 1) lsptunglinepolyline)) (cadr (nth (+ i 1) lsptunglinepolyline))))
			   ))
	  (setq lsptongline (append lsptongline (list (vlax-ename->vla-object (entlast)))))
	  (setq i (+ i 1))
	  )
	)
      (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
      (if (setq lsptongregion (vlax-invoke ms 'AddRegion lsptongline))
	(progn
	  (foreach lsptungline lsptongline
	    (entdel (vlax-vla-object->ename lsptungline))
	    )
	  (setq lsppolylinetong nil)
	  (foreach tungregion lsptongregion
	    (command "explode" (vlax-vla-object->ename tungregion) "")
	    (command "PEDIT" "m" (ssget "p") "" "y" "j" "0.00001" "")
	    (setq lspdoi (entget (entlast)))
	    (entmod (subst (cons 8 "PoLyline Tao Vung Kin") (assoc 8 lspdoi) lspdoi))
	    (setq lsppolylinetong (append lsppolylinetong (list (list (entlast) (vlax-curve-getarea (entlast))))))
	    )
	  (setq lsppolylinetong (vl-sort lsppolylinetong (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))))
	  (setq dientichtong 0.00)
	  (foreach dientich (cdr lsppolylinetong)
	    (setq dientichtong (+ dientichtong (cadr dientich)))
	    )
	  (if (<= (abs (- (cadr (car lsppolylinetong)) dientichtong)) 0.0001)
	    (entdel (car (car lsppolylinetong)))
	    )
	  (setq mau 1)
	  (foreach xetpl (cdr lsppolylinetong)
	    (if (>= mau 255)
	      (setq mau 1)
	      )
	    (entmakex-hatchvatlieu (list (cdr (ACET-GEOM-OBJECT-POINT-LIST (car xetpl) 1e-3))) "PoLyline Tao Vung Kin" mau "SLOID")
	    (setq mau (+ mau 12))
	    )
	  
	  )
	)
      )
    )
  )

[Doan Van Ha 3.191]

Hãy thử test trên file mà chủ topic đưa lên thì sẽ thấy. 

[Doan Van Ha 3.191]

Mình kiểm tra thì thấy lỗi là do lệnh trong breakall, các đối tượng tạo ra không đúng ngay vị trí giao

Trong file breakall.lsp, sửa 0.00001 => 1.e-10 ra kết quả OK với những đối tượng đã break

ndtnv thử viết hoàn chỉnh rồi test trên bản vẽ của chủ topic xem sao. Hình như thậm chí nó còn không tạo đủ region nếu đi theo phương án trên?

[doanduyhung 40]

mình up lại đây

lisp nay mình test rồi nó ổn khi các đối tượng phải giao nhau hết (không tính được như hình mẫu ở trên trường hợp line và spline nó không giao nhau còn các hình còn lại thì ok)

File mẫu phải khai báo lại tỉ lệ hatch mặc định lớn lên vd=10 nếu không nó không có hatch được

(defun LM:Intersections ( obj1 obj2 mode / l r )
    (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)
(defun LM:IntersectionsInSet ( ss / a b i j l )
    (repeat (setq i (sslength ss))
        (setq a (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (repeat (setq j i)
            (setq b (vlax-ename->vla-object (ssname ss (setq j (1- j))))
                  l (cons (LM:Intersections a b acextendnone) l)
            )
        )
    )
    (apply 'append (reverse l))
)
(defun DDH:pointtolsppoint (pointchen lsppointchen / vitrichen ii)
  (setq iii 0)
  (repeat (- (length lsppointchen) 1)
    (if (and (> (distance pointchen (nth (+ iii 1) lsppointchen)) 0.001)
	     (> (distance pointchen (nth iii lsppointchen)) 0.001)
	     )
      (progn
	(if (<= (abs (- (distance (nth iii lsppointchen) (nth (+ iii 1) lsppointchen))
			(+ (distance pointchen (nth (+ iii 1) lsppointchen))
			   (distance pointchen (nth iii lsppointchen))
			   )
			))
		     0.001)
	  (setq vitrichen (+ iii 1))
	  )
	)
      )
    (setq iii (+ iii 1))
    )
  (setq lsppointchen (LM:InsertNth pointchen vitrichen lsppointchen))
  )
(defun LM:InsertNth ( x n l )
  ((lambda ( k )
     (apply 'append
	    (mapcar '(lambda ( a ) (if (= n (setq k (1+ k))) (list x a) (list a))) l)
	    )
     )
    -1
    )
  )
(defun taopolyline (lst layer mau / x )
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons 70 0)
		  (cons 66 1)
		  (cons 8 layer)
		  (cons 62 mau)
		  )
	    (mapcar (function (lambda (x) (cons 10 x))) lst)
	    )
    )  
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:hatchkin(/)
  (vl-load-com)
  (princ "\nChon Cac Line, Polyline, Arc, Circle, Spline Hoac Ellipse De Tao Polyline Kin")
  (if (setq chonlinepolyline (ssget '((-4 . "<OR")(0 . "LINE")(0 . "CIRCLE")(0 . "SPLINE")(0 . "ARC")(0 . "ELLIPSE")(0 . "*POLYLINE")(-4 . "OR>"))))
    (progn   
      (setq chonpolyline (ssadd))
      (setq lsppolyline nil)
      (setq i 0)
      (repeat (sslength chonlinepolyline)
	(taopolyline (ACET-GEOM-OBJECT-POINT-LIST (ssname chonlinepolyline i)
		       (/ (vlax-curve-getdistatparam (ssname chonlinepolyline i) (vlax-curve-getendparam (ssname chonlinepolyline i)))
			  10000)) "0" 1)
	(ssadd (entlast) chonpolyline)
	(setq lsppolyline (append lsppolyline (list (ACET-GEOM-OBJECT-POINT-LIST (ssname chonlinepolyline i)
						      (/ (vlax-curve-getdistatparam (ssname chonlinepolyline i) (vlax-curve-getendparam (ssname chonlinepolyline i)))
							 10000)))))
	(setq i (+ i 1))
	)
      (setq lspgiaodiem (LM:IntersectionsInSet chonpolyline))
      (setq chonline (ssadd))
      (setq lspchonline nil)
      (foreach lsp lsppolyline
	(foreach diemgiao lspgiaodiem
	  (setq lsp (DDH:pointtolsppoint diemgiao lsp))
	  )
	(setq i 0)
	(repeat (- (length lsp) 1)
	  (entmakex (list '(0 . "LINE")
			    (cons 10 (nth i lsp))
			    (cons 11 (nth (+ i 1) lsp))
			    ))
	  (ssadd (entlast) chonline)
	  (setq lspchonline (append lspchonline (list (vlax-ename->vla-object (entlast)))))
	  (setq i (+ i 1))
	  )
	)     
      (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
      (if (setq lsptongregion (vlax-invoke ms 'AddRegion lspchonline))
	(progn
	  (command "ERASE" chonline "")
	  (command "ERASE" chonpolyline "")
	  (setq lspxetbien nil)
	  (foreach tungregion lsptongregion
	    (setq lspxetbien (append lspxetbien (list (list (vlax-vla-object->ename tungregion) (vlax-get-property tungregion 'area)))))
	    )
	  (setq lspxetbien (vl-sort lspxetbien (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))))
	  (setq dientichtong 0.00)
	  (foreach dientich (cdr lspxetbien)
	    (setq dientichtong (+ dientichtong (cadr dientich)))
	    )
	  (if (<= (abs (- (cadr (car lspxetbien)) dientichtong)) 0.0001)
	    (entdel (car (car lspxetbien)))
	    )
	  (setq mau 1)
	  (foreach xetpl (cdr lspxetbien)
	    (if (>= mau 255)
	      (setq mau 1)
	      )
	    (command "hatch" "" "" "" (car xetpl) "")
	    (command "change" (entlast) "" "p" "c" mau "")
	    (setq mau (+ mau 1))
	    )
	  
	  )
	)
      )
    )
  )

[Doan Van Ha 3.191]

Nếu chủ topic chấp nhận hatch "gần đúng" thì ổn.

[dragontalon0802 4]

Không biết tại đầu óc mình đen tối hay tại cái tít nhạy cảm nhỉ?

"vùng kín của các đối tượng giao nhau"

[huaductiep 2]

mình up lại đây

lisp nay mình test rồi nó ổn khi các đối tượng phải giao nhau hết (không tính được như hình mẫu ở trên trường hợp line và spline nó không giao nhau còn các hình còn lại thì ok)

File mẫu phải khai báo lại tỉ lệ hatch mặc định lớn lên vd=10 nếu không nó không có hatch được

(defun LM:Intersections ( obj1 obj2 mode / l r )
    (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)
(defun LM:IntersectionsInSet ( ss / a b i j l )
    (repeat (setq i (sslength ss))
        (setq a (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (repeat (setq j i)
            (setq b (vlax-ename->vla-object (ssname ss (setq j (1- j))))
                  l (cons (LM:Intersections a b acextendnone) l)
            )
        )
    )
    (apply 'append (reverse l))
)
(defun DDH:pointtolsppoint (pointchen lsppointchen / vitrichen ii)
  (setq iii 0)
  (repeat (- (length lsppointchen) 1)
    (if (and (> (distance pointchen (nth (+ iii 1) lsppointchen)) 0.001)
	     (> (distance pointchen (nth iii lsppointchen)) 0.001)
	     )
      (progn
	(if (<= (abs (- (distance (nth iii lsppointchen) (nth (+ iii 1) lsppointchen))
			(+ (distance pointchen (nth (+ iii 1) lsppointchen))
			   (distance pointchen (nth iii lsppointchen))
			   )
			))
		     0.001)
	  (setq vitrichen (+ iii 1))
	  )
	)
      )
    (setq iii (+ iii 1))
    )
  (setq lsppointchen (LM:InsertNth pointchen vitrichen lsppointchen))
  )
(defun LM:InsertNth ( x n l )
  ((lambda ( k )
     (apply 'append
	    (mapcar '(lambda ( a ) (if (= n (setq k (1+ k))) (list x a) (list a))) l)
	    )
     )
    -1
    )
  )
(defun taopolyline (lst layer mau / x )
  (entmakex
    (append (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length lst))
		  (cons 70 0)
		  (cons 66 1)
		  (cons 8 layer)
		  (cons 62 mau)
		  )
	    (mapcar (function (lambda (x) (cons 10 x))) lst)
	    )
    )  
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:hatchkin(/)
  (vl-load-com)
  (princ "\nChon Cac Line, Polyline, Arc, Circle, Spline Hoac Ellipse De Tao Polyline Kin")
  (if (setq chonlinepolyline (ssget '((-4 . "<OR")(0 . "LINE")(0 . "CIRCLE")(0 . "SPLINE")(0 . "ARC")(0 . "ELLIPSE")(0 . "*POLYLINE")(-4 . "OR>"))))
    (progn   
      (setq chonpolyline (ssadd))
      (setq lsppolyline nil)
      (setq i 0)
      (repeat (sslength chonlinepolyline)
	(taopolyline (ACET-GEOM-OBJECT-POINT-LIST (ssname chonlinepolyline i)
		       (/ (vlax-curve-getdistatparam (ssname chonlinepolyline i) (vlax-curve-getendparam (ssname chonlinepolyline i)))
			  10000)) "0" 1)
	(ssadd (entlast) chonpolyline)
	(setq lsppolyline (append lsppolyline (list (ACET-GEOM-OBJECT-POINT-LIST (ssname chonlinepolyline i)
						      (/ (vlax-curve-getdistatparam (ssname chonlinepolyline i) (vlax-curve-getendparam (ssname chonlinepolyline i)))
							 10000)))))
	(setq i (+ i 1))
	)
      (setq lspgiaodiem (LM:IntersectionsInSet chonpolyline))
      (setq chonline (ssadd))
      (setq lspchonline nil)
      (foreach lsp lsppolyline
	(foreach diemgiao lspgiaodiem
	  (setq lsp (DDH:pointtolsppoint diemgiao lsp))
	  )
	(setq i 0)
	(repeat (- (length lsp) 1)
	  (entmakex (list '(0 . "LINE")
			    (cons 10 (nth i lsp))
			    (cons 11 (nth (+ i 1) lsp))
			    ))
	  (ssadd (entlast) chonline)
	  (setq lspchonline (append lspchonline (list (vlax-ename->vla-object (entlast)))))
	  (setq i (+ i 1))
	  )
	)     
      (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
      (if (setq lsptongregion (vlax-invoke ms 'AddRegion lspchonline))
	(progn
	  (command "ERASE" chonline "")
	  (command "ERASE" chonpolyline "")
	  (setq lspxetbien nil)
	  (foreach tungregion lsptongregion
	    (setq lspxetbien (append lspxetbien (list (list (vlax-vla-object->ename tungregion) (vlax-get-property tungregion 'area)))))
	    )
	  (setq lspxetbien (vl-sort lspxetbien (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))))
	  (setq dientichtong 0.00)
	  (foreach dientich (cdr lspxetbien)
	    (setq dientichtong (+ dientichtong (cadr dientich)))
	    )
	  (if (<= (abs (- (cadr (car lspxetbien)) dientichtong)) 0.0001)
	    (entdel (car (car lspxetbien)))
	    )
	  (setq mau 1)
	  (foreach xetpl (cdr lspxetbien)
	    (if (>= mau 255)
	      (setq mau 1)
	      )
	    (command "hatch" "" "" "" (car xetpl) "")
	    (command "change" (entlast) "" "p" "c" mau "")
	    (setq mau (+ mau 1))
	    )
	  
	  )
	)
      )
    )
  )

Em còn gặp lỗi là nếu ta quét chọn nhiều hình cùng lúc (như file em gửi là em quét chọn cả 6 khối hình 1 lúc) thì sau khi Hatchkin có một số vùng Hatch được tạo ra bao toàn bộ tất cả các hình. Mà em chỉ muốn nó ra kết quả Hatch ở mỗi vùng riêng biệt thôi. Và Bác có thể chỉnh cho em cái phần sau khi hatch xong thì nó mất cái phần Region được tạo ra đó ko ah? 

Nói chung Lisp đã rất tuyệt rồi. Bác chỉnh giúp em mấy cái này nữa nhá. Em cám ơn các Bác nhiều lắm  :) http://www.cadviet.com/upfiles/3/64997_test_hatch_2.dwg

[doanduyhung 40]

Em còn gặp lỗi là nếu ta quét chọn nhiều hình cùng lúc (như file em gửi là em quét chọn cả 6 khối hình 1 lúc) thì sau khi Hatchkin có một số vùng Hatch được tạo ra bao toàn bộ tất cả các hình. Mà em chỉ muốn nó ra kết quả Hatch ở mỗi vùng riêng biệt thôi. Và Bác có thể chỉnh cho em cái phần sau khi hatch xong thì nó mất cái phần Region được tạo ra đó ko ah? 

Nói chung Lisp đã rất tuyệt rồi. Bác chỉnh giúp em mấy cái này nữa nhá. Em cám ơn các Bác nhiều lắm  :) http://www.cadviet.com/upfiles/3/64997_test_hatch_2.dwg

đúng rồi chỉ đúng chọn 1 nhóm giao và loại đối tượng bao chung, chưa xét chọn nhiều nhóm, đang tìm cách để lọc cái đó