Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

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

Chào các bác.từ khi tham gia diễn đàn em cũng học hỏi các anh trong diễn đàn được chút ít.

em mới viết được 1 chương trình lisp xem các pác xem giúp em.

Còn phần đồ án của em .Vì đây là lần đầu làm nên em chưa có nhiều hiểu biết về cách trình bày của 1 đồ án môn học về lập trình như thế này .Em mới trình bày được một ít mong các anh hãy góp cho em xem em phải trình bày như thế nào?

còn về mô phỏng AutoLISP thì phải mô phỏng theo 2d hay là 3D ạ? em cảm ơn.

đồ án môn học

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
Có bác nào viết dùm mình cái lisp dùng để vẽ thang cáp điện cho nhanh không?

Mô tả thang cáp điện như trong bản vẽ đính kèm

http://www.cadviet.com/upfiles/2/cable_trunking.dwg

Cám ơn nhiều.

Chào xuanvi80, bạn dùng lisp này tạm nhé. Thiep chưa kiểm tra kỹ, nhưng thấy nó vẫn chạy tốt. Lệnh là thangcap.

;;;CHUONG TRINH VE THANG CAP DIEN - CAP TRUNKING
;;;Written by THIEP - 01- 2010 - www.cadviet.com
;;;require install express tool

(defun offset (OBJ flag)
 (vlax-vla-object->ename
   (car (vlax-safearray->list
   (variant-value (vla-offset OBJ flag))
 )
   )
 )
)
(defun line (Model p1 p2)
 (vla-AddLine
   Model
   (vlax-3d-point p1)
   (vlax-3d-point p2)
 )
)

(vl-load-com)
(defun C:thangcap (/ chon e    pC   pM	 xM   L	   ps	pe   n	  S
	     p01  x    flag p02	 a    p1   p2	p3   p4	  i
	     oldos     p03  p5	 p6
	    )
 (setq	ActDoc	 (vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	 (vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq oldcmdo (getvar "cmdecho"))
 (setq oldos (getvar "osmode"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (setq	d0 (cond (d0)
	 (500)
   )
 )
 (setq oldd0 d0)
 (setq	d0 (getreal (strcat "\nDuong kinh thang (L) <"
		    (rtos oldd0 2 0)
		    "> : "
	    )
   )
 )
 (if (null d0)
   (setq d0 oldd0)
 )
 (setq	N0 (cond (N0)
	 (300)
   )
 )
 (setq oldN0 N0)
 (setq	N0 (getreal (strcat "\nBuoc thang (N) <"
		    (rtos oldN0 2 0)
		    "> : "
	    )
   )
 )
 (if (null N0)
   (setq N0 oldN0)
 )
 (setq	p1  (getpoint "\npick a point: ")
Lpo (list p1)
 )
 (while (setq p2 (getpoint p1 "\nPick a point continuous: "))
   (setq Lpo (append Lpo (list p2)))
   (GRDRAW p1 p2 7 0)
   (setq p1 p2)

 )
 (ACET-LWPLINE-MAKE (list Lpo))
 (setq	ent  (entlast)
OBJ  (vlax-ename->vla-object ent)
flag (/ d0 2)
Lcur (vla-get-Length OBJ)
 )
 (setq	en1  (offset OBJ (+ flag 30))
en2  (offset OBJ (- (+ flag 30)))
en3  (offset OBJ flag)
en4  (offset OBJ (- flag))
lst1 (ACET-GEOM-VERTEX-LIST en1)
lst2 (ACET-GEOM-VERTEX-LIST en2)
n    0
 )
 (repeat (length lst1)
   (line *Model* (nth n lst1) (nth n lst2))
   (setq n (1+ n))
 )
 (setq	n  (fix (/ Lcur N0))
l1 (/ N0 2))
 (repeat (+ n 1)
   (setq p1 (vlax-curve-getPointAtDist ent l1)
  p2 (vlax-curve-getClosestPointTo en3 p1)
  p3 (vlax-curve-getClosestPointTo en4 p1)
   )
   (offset (line *Model* p2 p3) 30)
   (setq l1 (+ l1 N0))
 )
 (vla-delete OBJ)
 (vla-put-Comments
   (vla-get-SummaryInfo
     ActDoc
     )
   (setq ok "Thank you for use thangcap.lsp! THIEP 0918841230")
 )
 (vla-EndUndoMark ActDoc)
 (setvar "cmdecho" oldcmdo)
 (setvar "osmode" oldos)
 (princ ok)
)

  • Like 1
  • Vote tăng 3

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

Cám ơn bạn Thiep rất nhiều!!! Có cái này rồi mình sẽ vẽ nhanh hơn rất nhiều.

 

Tuy nhiên về AutoLisp mình biết không nhiều, do vậy nhờ bạn bổ sung giúp một vài thao tác nữa cho lệnh hoàn thiện hơn nhé:

 

-Sau khi vẽ thang cáp xong thì xóa đường cơ sở ở giữa đi.

-Các đường biên ngoài của thang đặt ở layer hiện tại (current layer)

-Các bước thang đổi sang layer "E-AUXL", đây là layer có sẵn trong bản vẽ của mình, nếu chưa có thì tự động tạo mới

-Nếu có thể thì đóng toàn bộ thang cáp thành 1 Block thì tốt.

 

Như vậy quản lý thang cáp và chỉnh nét khi in ấn sẽ tốt hơn.

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
Chào bạn ohay102,

Rất tiếc là mình dùng cad2004 nên không mở được file bạn gửi. Bạn có thể gửi lại file ở dạng cad2004 được không???

Cảm ơn bác binh , mấy hôm nay em về quê nên không gửi được, đây là file đã chuyển sang cad 2004 bác kiểm tra hộ

http://www.mediafire.com/?dn4omcm21dz

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
Cám ơn bạn Thiep rất nhiều!!! Có cái này rồi mình sẽ vẽ nhanh hơn rất nhiều.

 

Tuy nhiên về AutoLisp mình biết không nhiều, do vậy nhờ bạn bổ sung giúp một vài thao tác nữa cho lệnh hoàn thiện hơn nhé:

 

-Sau khi vẽ thang cáp xong thì xóa đường cơ sở ở giữa đi.

-Các đường biên ngoài của thang đặt ở layer hiện tại (current layer)

-Các bước thang đổi sang layer "E-AUXL", đây là layer có sẵn trong bản vẽ của mình, nếu chưa có thì tự động tạo mới

-Nếu có thể thì đóng toàn bộ thang cáp thành 1 Block thì tốt.

 

Như vậy quản lý thang cáp và chỉnh nét khi in ấn sẽ tốt hơn.

Chào xuanvi80 Lisp này, Thiep đã fix theo ý Xuanvi80, còn đóng gói toàn bộ thang cáp thành 1 Block, thì XuanVi tự làm lấy theo ý mình thôi.

;;;CHUONG TRINH VE THANG CAP DIEN - CAP TRUNKING
;;;Written by THIEP 01/2010  www.cadviet.com
;;;require install express tool
(defun off (OBJ flag)
 (car (vlax-safearray->list
 (variant-value (vla-offset OBJ flag))
      )
 )
)
(defun line (Model p1 p2)
 (vla-AddLine
   Model
   (vlax-3d-point p1)
   (vlax-3d-point p2)
 )
)

(vl-load-com)
(defun C:thangcap (/ ActDoc *Model* *layer* enlay lay p1 p2 p3 Lpo ent
	     obj Lcur flag obj1 obj2 obj3 obj4 lst1 lst2 n N0 l1 ok)
 (setq	ActDoc	 (vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	 (vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq oldcmdo (getvar "cmdecho"))
 (setq oldos (getvar "osmode"))
 (setq oldlay (getvar "clayer"))
 (if (not (setq enlay (tblobjname "layer" "E-AUXL")))
     (setq lay (vla-add *layer* "E-AUXL"))
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "E-AUXL"))
   )
 )
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (setq	d0 (cond (d0)
	 (500)
   )
 )
 (setq oldd0 d0)
 (setq	d0 (getreal (strcat "\nDuong kinh thang (L) <"
		    (rtos oldd0 2 0)
		    "> : "
	    )
   )
 )
 (if (null d0)
   (setq d0 oldd0)
 )
 (setq	N0 (cond (N0)
	 (300)
   )
 )
 (setq oldN0 N0)
 (setq	N0 (getreal (strcat "\nBuoc thang (N) <"
		    (rtos oldN0 2 0)
		    "> : "
	    )
   )
 )
 (if (null N0)
   (setq N0 oldN0)
 )
 (setq	p1  (getpoint "\npick a point: ")
Lpo (list p1)
 )
 (while (setq p2 (getpoint p1 "\nPick a point continuous: "))
   (setq Lpo (append Lpo (list p2)))
   (GRDRAW p1 p2 7 0)
   (setq p1 p2)

 )
 (ACET-LWPLINE-MAKE (list Lpo))
 (setq	ent  (entlast)
OBJ  (vlax-ename->vla-object ent)
flag (/ d0 2)
Lcur (vla-get-Length OBJ)
 )
 (setq	obj1 (off OBJ (+ flag 30))
obj2 (off OBJ (- (+ flag 30)))
obj3 (off OBJ flag)
obj4 (off OBJ (- flag))
 )
 (setq	lst1 (ACET-GEOM-VERTEX-LIST (vlax-vla-object->ename obj1))
lst2 (ACET-GEOM-VERTEX-LIST (vlax-vla-object->ename obj2))
n    0
 )
 (repeat (length lst1)
   (line *Model* (nth n lst1) (nth n lst2))
   (setq n (1+ n))
 )
 (setq	n  (fix (/ Lcur N0))
l1 (/ N0 2))
 (setvar "clayer" "E-AUXL")
 (repeat n
   (setq p1 (vlax-curve-getPointAtDist ent l1)
  p2 (vlax-curve-getClosestPointTo obj3 p1)
  p3 (vlax-curve-getClosestPointTo obj4 p1)
   )
   (off (line *Model* p2 p3) 30) 
   (setq l1 (+ l1 N0))
 )
 (vla-delete OBJ)
 (vla-put-Comments
   (vla-get-SummaryInfo
     ActDoc
     )
   (setq ok "Thank you for use thangcap.lsp! THIEP 0918841230")
 )
 (vla-Regen ActDoc acActiveViewport)
 (vla-EndUndoMark ActDoc)
 (setvar "cmdecho" oldcmdo)
 (setvar "osmode" oldos)
 (setvar "clayer" oldlay)
 (princ ok)
)

 

cần giúp đỡ

xin chỉ giùm lisp tự động chọn các đối tượng được tạo sau lệnh copy

cám ơn nhiều

Chào nguyenh001, sau khi bạn viết mã lisp để copy các đối tượng xong, bạn dùng mã lisp sau đây để chọn lại các đối tượng vừa được copy:

(setq sscopy (ssget "_P"))

  • Vote tăng 2
  • Vote giảm 1

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
Cảm ơn bác binh , mấy hôm nay em về quê nên không gửi được, đây là file đã chuyển sang cad 2004 bác kiểm tra hộ

http://www.mediafire.com/?dn4omcm21dz

Rất xin lỗi bạn ohay102, mình đang kẹt mấy cáiho75o75p đồng phải kết thúc trước Tết Canh Dần nên chưa kịp sờ tới cái yêu cầu của bạn. Bản vẽ của bạn bác Huong 259 đã chuyển giùm về CAD2004 nên mình đã xem. Phần tạo bảng không khó, nhưng kẹt ở phần tạo lớp do phải xác định các tọa độ điểm đấu cà điểm cuối mà như trong bản vẽ bạn gửi thì có thể một đường cắt lớp sẽ cho tới hai điểm đầu và hai điểm cuối. Vì thế nên xác định nó thật chuẩn mình chưa có giải pháp. Vì bận quá nên cũng chưa tập trung suy nghĩ được, mong bạn thư thư cho vài bữa. Chắc sau OFFLINE mình mới rảnh rảnh được bạn ạ.

À mà bạn ở đâu nhỉ? Sao không tham dự offline cho vui và để anh em còn biết mặt nhau, kẻo có lúc lại uýnh nhầm thì chết..... Hề hề hề.

Chúc bạn năm mới vạn sự thành công nhưng chớ có thành ÔNG thì mệt lắm...

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
Chào nguyenh001, sau khi bạn viết mã lisp để copy các đối tượng xong, bạn dùng mã lisp sau đây để chọn lại các đối tượng vừa được copy:

(setq sscopy (ssget "_P"))

ban ơi, mình đã thử nhưng không được, lệnh của bạn chỉ là chọn lại các đối tượng gốc,mình cần chọn các đối tượng do lệnh copy tạo ra

cám ơn bạn.

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

Các bác giúp em viết code:

Em có hai đường đồng mức +0 và +5 em muốn chèn thêm vào giữa hai đường này 4 đường nữa, sao cho các đường này tỷ lệ với các đường +0 và +5. Các bác giúp em voi

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
À mà bạn ở đâu nhỉ? Sao không tham dự offline cho vui và để anh em còn biết mặt nhau, kẻo có lúc lại uýnh nhầm thì chết..... Hề hề hề.

Chúc bạn năm mới vạn sự thành công nhưng chớ có thành ÔNG thì mệt lắm...

Tiếc quá! chỗ mọi người tổ chức ở bình thạnh ngay gần trường cũ nhưng hiện nay em đang đi công trình nên kô thể tham gia đc.

chúc mọi người hôm đó có buổi offline vui vẻ bổ ích

  • Vote tăng 1

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

Em sưu tầm đc 1 block sau, khi thay đổi vị trí thì toạ độ hiên trên block của thay đổi theo, e thấy khá hay, nhưng block sẽ hoàn thiện hơn nữa nếu ta thêm vào tên nút và bảng thống kê toạ độ như các lisp toạ độ khác vẫn hay có. bác nào có thể hoàn thiện theo ý của em nói đc không?

http://www.cadviet.com/upfiles/2/block_2.dwg

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

Nhờ mọi người viết cho mình cái lisp như sau:

mình có các số cao độ, giờ muốn sửa chúng hàng loạt bằng cách:

gõ lệnh

chọn các cao độ

nhập giá trị muốn cộng (trừ thêm vào giá trị)

kết thúc và các cao độ đó sẽ cập nhật lại kết quả sau khi cộng hoặc trừ. Thanks

  • Vote giảm 1

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

Mình mới thử viết 1 lisp sau đây, đổi tên nhiều text cùng lúc, n text A thành n text B và ngược lại.

VD: có 3 text A : 4 5 6

3 text B: 7 8 9

( Sắp xếp từ trái qua phải, khoảng cách có thể khác nhau)

sau khi dùng lisp 3 text A sẽ thành 7 8 9 , 3 text B sẽ thành 4 5 6

 

Nhưng gặp phải vấn đề là đôi khi text A lại thành 7 9 8 . Lí do là text 7 được tạo ra trước , đến text 9, rồi đến text 8 (do người làm trước đó tạo ra).

 

Nếu chọn text A theo kiểu pick từng text thì sẽ ra kq đúng, nhưng mất thời gian, ở đây mình chọn theo kiểu khoanh vùng 1 cái là xong.

 

Bạn nào giúp mình viết thêm đoạn code để lọc, sắp xếp thứ tự các text trong text A được ko ?

Sắp xếp thứ tự phần tử trong ss theo thứ tự từ phải qua trái (hoặc trái qua phải).

 

 

Đây là file cad

http://www.cadviet.com/upfiles/2/text.dwg

(Trường hợp sai bên phải)

 

(defun c:cs()


(setq ss (ssget '((0 . "TEXT"))))
(setq sx (ssget '((0 . "TEXT"))))

(setq n (sslength ss) i 0)


(while (< i n)

(setq nn (entget (ssname ss i)))
(setq mm (entget (ssname sx i)))

(setq li (cdr (assoc 1 nn)))

(setq li1 (cdr (assoc 1 mm)))


(setq nn (subst (cons 1 li1) (assoc 1 nn) nn))
(setq mm (subst (cons 1 li) (assoc 1 mm) mm))

(entmod mm)
(entmod nn)
(setq i (+ i 1))

)

(princ)

)

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
Mình mới thử viết 1 lisp sau đây, đổi tên nhiều text cùng lúc, n text A thành n text B và ngược lại.

VD: có 3 text A : 4 5 6

3 text B: 7 8 9

( Sắp xếp từ trái qua phải, khoảng cách có thể khác nhau)

sau khi dùng lisp 3 text A sẽ thành 7 8 9 , 3 text B sẽ thành 4 5 6

 

Nhưng gặp phải vấn đề là đôi khi text A lại thành 7 9 8 . Lí do là text 7 được tạo ra trước , đến text 9, rồi đến text 8 (do người làm trước đó tạo ra).

 

Nếu chọn text A theo kiểu pick từng text thì sẽ ra kq đúng, nhưng mất thời gian, ở đây mình chọn theo kiểu khoanh vùng 1 cái là xong.

 

Bạn nào giúp mình viết thêm đoạn code để lọc, sắp xếp thứ tự các text trong text A được ko ?

Sắp xếp thứ tự phần tử trong ss theo thứ tự từ phải qua trái (hoặc trái qua phải).

Viết lại cho bạn nè :

(defun c:cs(/ ss sx lis1 lis2 n i nn mm li li1)
(vl-load-com)
(setq ss (ssget '((0 . "TEXT"))))
(setq sx (ssget '((0 . "TEXT"))))
(setq lis1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lis2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))
(setq lis1 (vl-sort lis1 '(lambda (x y) 
		(			   (cadr (assoc 10 (entget y)))
		)
	     )
    )
)
(setq lis2 (vl-sort lis2 '(lambda (x y) 
		(			   (cadr (assoc 10 (entget y)))
		)
	     )
    )
)	
(setq n (sslength ss) i 0)

(if (= (length lis1) (length lis2))
(progn
  (while (
(setq nn (entget (nth i lis1)))
(setq mm (entget (nth i lis2)))

(setq li (cdr (assoc 1 nn)))

(setq li1 (cdr (assoc 1 mm)))


(setq nn (subst (cons 1 li1) (assoc 1 nn) nn))
(setq mm (subst (cons 1 li) (assoc 1 mm) mm))

(entmod mm)
(entmod nn)
(setq i (+ i 1))

)
)
(alert "\n Hai chuoi khong bang nhau. Lisp khong thuc hien duoc")
)

(princ)

)

Trong code Lisp có kiểm tra sự bằng nhau của 2 chuỗi Text

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

Chào các bác,

 

Bác nào có tài liệu hướng dẫn sử dụng các lệnh trong autolisp như: vl-string, vl-get-resource, vlax-get-property .... (tóm lại là những lệnh bắt đầu bằng vl...), những lệnh khác trong lisp thì em hiểu (getpoint, setq, entget, ....).

 

Bác nào có tài liệu thì share giúp nhé,

 

Cảm ơn các bác.

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
Nhờ mấy Bác giúp cho cái lisp này với:

lisp.jpg

Còn đây là file CAD

http://www.cadviet.com/upfiles/2/lisp.dwg

Chào bạn Nộ Thiên!

Bạn là dân Lisp chuyên nghiệp, 3 yêu cầu trên có lẽ không thành vấn đề? Ssg chỉ góp ý phương án cho yêu cầu cuối cùng "chuyển các đường line biên thành màu green". Điểm mấu chốt của bài toán là làm thế nào để chương trình nhận ra được những line nào là "line biên"?

Xin được đặt lại bài toán ở dạng tương đương:

Cho một tập điểm S. Hãy xác định đa giác lồi P, chứa toàn bộ các điểm thuộc S, mỗi đỉnh của P là 1 điểm thuộc S.

Xem hình dưới đây:

bound1.jpg

Thuật giải như sau:

1- Xác định điểm có tung độ nhỏ nhất trong các điểm thuộc S -> đặt là điểm A. Chắc chắn A là 1 điểm thuộc P

2- Từ A, xác định angle đến tất cả các điểm còn lại của S. Điểm ứng với angle nhỏ nhất chính là điểm tiếp theo của đa giác P theo chiều ngược kim đồng hồ (điểm B trên hình).

3- Xoay hệ trục tọa độ như hình dưới:

bound2.jpg

Tương tự như bước 2, điểm tiếp theo C là điểm có angle nhỏ nhất trong hệ tọa độ này

4- Tiếp tục làm tương tự cho đến khi quay về lại điểm A

Kết quả cuối cùng là một tập điểm có thứ tự, xác định đa giác lồi P, thỏa mãn điều kiện bài toán.

  • Vote tăng 2

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
Chào bạn Nộ Thiên!

Bạn là dân Lisp chuyên nghiệp, 3 yêu cầu trên có lẽ không thành vấn đề? Ssg chỉ góp ý phương án cho yêu cầu cuối cùng "chuyển các đường line biên thành màu green". Điểm mấu chốt của bài toán là làm thế nào để chương trình nhận ra được những line nào là "line biên"?

Xin được đặt lại bài toán ở dạng tương đương:

Cho một tập điểm S. Hãy xác định đa giác lồi P, chứa toàn bộ các điểm thuộc S, mỗi đỉnh của P là 1 điểm thuộc S.

Xem hình dưới đây:

bound1.jpg

Thuật giải như sau:

1- Xác định điểm có tung độ nhỏ nhất trong các điểm thuộc S -> đặt là điểm A. Chắc chắn A là 1 điểm thuộc P

2- Từ A, xác định angle đến tất cả các điểm còn lại của S. Điểm ứng với angle nhỏ nhất chính là điểm tiếp theo của đa giác P theo chiều ngược kim đồng hồ (điểm B trên hình).

3- Xoay hệ trục tọa độ như hình dưới:

bound2.jpg

Tương tự như bước 2, điểm tiếp theo C là điểm có angle nhỏ nhất trong hệ tọa độ này

4- Tiếp tục làm tương tự cho đến khi quay về lại điểm A

Kết quả cuối cùng là một tập điểm có thứ tự, xác định đa giác lồi P, thỏa mãn điều kiện bài toán.

Bác ssg và các bác trên diễn đàn có thể code giúp Tue_NV bài toán trên được không?

Bài toán :

Cho một tập điểm S. Hãy xác định đa giác lồi P, chứa toàn bộ các điểm thuộc S, mỗi đỉnh của P là 1 điểm thuộc S.

Cảm ơn bác ssg và mọi người nhiều lắm

Tue_NV

  • Vote tăng 2

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
Bác ssg và các bác trên diễn đàn có thể code giúp Tue_NV bài toán trên được không?

Bài toán :

Cho một tập điểm S. Hãy xác định đa giác lồi P, chứa toàn bộ các điểm thuộc S, mỗi đỉnh của P là 1 điểm thuộc S.

Cảm ơn bác ssg và mọi người nhiều lắm

Tue_NV

Có thể hiểu bài toán của bạn như sau :

Cho một tập điểm S.

- Kiểm tra xem tập điểm S có tạo thành 1 đa giác lồi hay không ?

- Nếu tập điểm S có tạo thành 1 đa giác lồi -> tìm (vẽ) đa giác lồi đó.

 

Tạm bỏ qua bước 1,

bước 2 : vẽ đa giác lồi qua tập điểm S

- dùng giải thuật tìm đường biên của bác SSG cho tập điểm S -> tìm được đa giác lồi P' là đa giác đường biên của tập điểm S.

- nếu :

+ số đỉnh của đa giác lồi P' bằng số điểm của tập điểm S -> tập điểm S có tạo thành 1 đa giác lồi, đa giác lồi P' cũng chính là đa giác lồi cần tìm.

+ ngược lại -> tập điểm S không tạo thành 1 đa giác lồi .

  • Vote tăng 1

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
Nhờ mấy Bác giúp cho cái lisp này với:

lisp.jpg

Lên mạng tìm đc mấy cái lisp liên quan đến "Break" : đem về từ từ ngcứu tiếp.

http://www.cadviet.com/upfiles/2/asmitools_bri.lsp

http://www.cadviet.com/upfiles/2/breakobjects18.lsp

 

Thx to SSG!

  • Vote tăng 1

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
Nhờ mấy Bác giúp cho cái lisp này với:

lisp.jpg

Còn đây là file CAD

http://www.cadviet.com/upfiles/2/lisp.dwg

Bạn đưa ra bài toán này có vẽ hay gặp trong ngành bản đồ. Nều xử lý trên dữ liệu lớn đây là bài toán rất khó. Đòi hỏi phải lập trình nghiêm túc. Tuy nhiên, nếu dữ liệu nhò, vấn đề tìm đối tượng trùng nhau hay cắt nhỏ chúng tại điểm giao nhau trên diễn đàn đã có nhiều rồi.

Nói chung bài toán của bạn có thể kết hợp một số lệnh của cad như sau :

1- Rã các pline thành line (cad có)

2- tìm và xóa các line trùng (cad có)

3- tìm đường bao ngoài (có thể sd lệnh region)

4- cắt nhỏ các line bên trong tại các điểm giao (lisp trên diễn đàn đã có)

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
Bác ssg và các bác trên diễn đàn có thể code giúp Tue_NV bài toán trên được không?

Bài toán :

Cho một tập điểm S. Hãy xác định đa giác lồi P, chứa toàn bộ các điểm thuộc S, mỗi đỉnh của P là 1 điểm thuộc S.

Cảm ơn bác ssg và mọi người nhiều lắm

Tue_NV

có phải yêu cầu của Tue_NV là cái này không? http://www.cadviet.com/upfiles/2/dgl.lsp

lệnh là DGL tức là đa giác lồi

Link vá lỗi: http://www.cadviet.com/upfiles/2/dgl_5.lsp

  • Vote tăng 1

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
có phải yêu cầu của Tue_NV là cái này không? http://www.cadviet.com/upfiles/2/dgl.lsp

lệnh là DGL tức là đa giác lồi

Cảm ơn bạn tomboy nhiều lắm. Đúng ý mình rồi.

Tiện thể, bạn có thể bớt chút thời gian viết thêm cho trường hợp là đa giác lõm được không?

 

Cảm ơn tomboy nhiều

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

Lisp này mình down được của anh Thaistreetz!Nhờ các bạn chỉnh sửa dùm mình 1 tí nhen!

Mình muốn khi sử dụng lisp!Lisp sẽ cho phép mình tự nhập số thứ tự lô đất bắt đầu! hiện nay Lisp đang mặc định số đầu tiên là 1!

http://www.cadviet.com/upfiles/2/r.lsp

Thanks và chúc sức khỏe mọi người!

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×