Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
37 replies to this topic

#1 huaductiep

huaductiep

    biết vẽ rectang

  • Members
  • PipPip
  • 85 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 11 January 2014 - 10:27 PM

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.c...est_hatch_1.dwg

64997_screenshot_78.png


  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 January 2014 - 11:50 PM

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?


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 huaductiep

huaductiep

    biết vẽ rectang

  • Members
  • PipPip
  • 85 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 12 January 2014 - 10:17 PM

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?


  • 0

#4 huaductiep

huaductiep

    biết vẽ rectang

  • Members
  • PipPip
  • 85 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 13 January 2014 - 07:23 PM

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 ^^


  • 0

#5 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 13 January 2014 - 09:16 PM

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.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#6 huaductiep

huaductiep

    biết vẽ rectang

  • Members
  • PipPip
  • 85 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 13 January 2014 - 09:23 PM

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  :)


  • 0

#7 doanduyhung

doanduyhung

    biết vẽ spline

  • Members
  • PipPip
  • 90 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 14 January 2014 - 09:39 AM

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
  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 January 2014 - 09:52 AM

Dễ vô cùng!


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 14 January 2014 - 11:03 AM

Nhiều chuyện tí:

Tại sao ko đi:

Region ->>> Hatch

Mà đi:

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

???

:mellow:


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 January 2014 - 12:04 PM

@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)?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 doanduyhung

doanduyhung

    biết vẽ spline

  • Members
  • PipPip
  • 90 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 14 January 2014 - 12:10 PM

-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
  • 0

#12 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 January 2014 - 01:30 PM

-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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#13 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 14 January 2014 - 02:18 PM

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ị


  • 0

#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 January 2014 - 02:33 PM

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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 14 January 2014 - 03:10 PM

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


  • 0

#16 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 14 January 2014 - 03:13 PM

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..........


  • 0

#17 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 14 January 2014 - 04:15 PM

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


  • 1

#18 doanduyhung

doanduyhung

    biết vẽ spline

  • Members
  • PipPip
  • 90 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 14 January 2014 - 07:19 PM

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))
	    )
	  
	  )
	)
      )
    )
  )

  • 0

#19 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 January 2014 - 09:23 PM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#20 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 15 January 2014 - 10:29 AM

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?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.