Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2848 replies to this topic

#1801 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 02:17 PM

Em dùng một số hàm sau đây để vẽ lại 3D Polyline từ 2D Polyline có các đỉnh đi qua các TEXT.

Tại mỗi đỉnh 2D Polyline em cứ phải duyệt qua tất cả các Text có trong bản vẽ. 

Cho em hỏi các bác xem còn cách nào làm tối ưu hơn không ạ?

Đây là CODE của em.

(vl-load-com)
(defun C:CV3D23D(/ Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ss (ssget "_X" (list (cons 0 "TEXT"))))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if  (= (acet-dxf 0 (entget x)) "TEXT")  (TD:Text-Base x) nil)) (acet-ss-to-list ss))))
(setq ss2 (vl-sort (vl-sort ss1 '(lambda(x y) (< (car x) (car y)))) '(lambda(x y) (< (cadr x) (cadr y)))))

(setq ssObjPline (ssget (list (cons 0 "*POLYLINE"))))
(setq LtsObjPline (acet-ss-to-list ssObjPline))
(foreach en LtsObjPline
	(CV1PL3D en ss2)
)
(setvar "OSMODE" Olmode)
(princ)
)




(defun CV1PL3D( ObjPline ss2 / Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(setvar "OSMODE" 0)
(setq ob (vlax-ename->vla-object ObjPline)
       n (vlax-curve-getEndParam ob)
)
(setq Lts1 (list))
(setq Pnt_i nil)
(setq i 0)
(while (<= i n)
	(progn
		(setq P1 (vlax-curve-getPointAtParam ob i))
		(setq Pnt_text (car (vl-sort ss2 '(lambda(x y) (< (distance x P1) (distance y P1))))))
	  	(if (and (equal (car P1) (car Pnt_text) 0.0000000001) (equal (cadr P1) (cadr Pnt_text) 0.0000000001))
			 (setq Pnt_i Pnt_text)
		  	 (setq Pnt_i P1)
	  	)
		(setq Lts1 (append Lts1 (list Pnt_i)))
	)
(setq i (+ i 1))
)
(entdel ObjPline)
(MakePolyline3D Lts1)
)


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)


(defun MakePolyline3D (vtcs)
  (entmake
    (list
    '(0 . "POLYLINE")
    '(66 . 1)
    '(70 . 8)
    )
  )
  (foreach vtx vtcs
    (entmake
      (list
      '(0 . "VERTEX")
      (cons 10 vtx)
      '(70 . 32)
      )
    )
  )
  (entmake '((0 . "SEQEND")))
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1802 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 August 2014 - 02:49 PM


 

Em dùng một số hàm sau đây để vẽ lại 3D Polyline từ 2D Polyline có các đỉnh đi qua các TEXT.

Tại mỗi đỉnh 2D Polyline em cứ phải duyệt qua tất cả các Text có trong bản vẽ. 

Cho em hỏi các bác xem còn cách nào làm tối ưu hơn không ạ?

Đây là CODE của em.

(vl-load-com)
(defun C:CV3D23D(/ Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ss (ssget "_X" (list (cons 0 "TEXT"))))
(setq ss1 (vl-remove nil (mapcar '(lambda(x) (if  (= (acet-dxf 0 (entget x)) "TEXT")  (TD:Text-Base x) nil)) (acet-ss-to-list ss))))
(setq ss2 (vl-sort (vl-sort ss1 '(lambda(x y) (< (car x) (car y)))) '(lambda(x y) (< (cadr x) (cadr y)))))

(setq ssObjPline (ssget (list (cons 0 "*POLYLINE"))))
(setq LtsObjPline (acet-ss-to-list ssObjPline))
(foreach en LtsObjPline
	(CV1PL3D en ss2)
)
(setvar "OSMODE" Olmode)
(princ)
)




(defun CV1PL3D( ObjPline ss2 / Olmode en n ob Pnt_i Lts1 i P1 Pnt_TB  Pnt_DN y ss1 Pnt_i e)
(setvar "OSMODE" 0)
(setq ob (vlax-ename->vla-object ObjPline)
       n (vlax-curve-getEndParam ob)
)
(setq Lts1 (list))
(setq Pnt_i nil)
(setq i 0)
(while (<= i n)
	(progn
		(setq P1 (vlax-curve-getPointAtParam ob i))
		(setq Pnt_text (car (vl-sort ss2 '(lambda(x y) (< (distance x P1) (distance y P1))))))
	  	(if (and (equal (car P1) (car Pnt_text) 0.0000000001) (equal (cadr P1) (cadr Pnt_text) 0.0000000001))
			 (setq Pnt_i Pnt_text)
		  	 (setq Pnt_i P1)
	  	)
		(setq Lts1 (append Lts1 (list Pnt_i)))
	)
(setq i (+ i 1))
)
(entdel ObjPline)
(MakePolyline3D Lts1)
)


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)


(defun MakePolyline3D (vtcs)
  (entmake
    (list
    '(0 . "POLYLINE")
    '(66 . 1)
    '(70 . 8)
    )
  )
  (foreach vtx vtcs
    (entmake
      (list
      '(0 . "VERTEX")
      (cons 10 vtx)
      '(70 . 32)
      )
    )
  )
  (entmake '((0 . "SEQEND")))
)

Mình có mấy góp ý sau:

1./ Đã sử dụng hàm entmake vẽ POLYLINE thì không cần phải tắt chế độ bắt điểm. Vì khi tạo đối tượng bằng entmake thì không phụ thuộc vào chế độ bắt điểm

2./ Nên sử dụng hàm Repeat để lặp khi biết trước số lần lặp, không nên dùng While vì dùng While thì cứ mỗi lần lặp thì phải kiểm tra điều kiện lặp (mục đích đẩy nhanh tốc độ)

3./ Hàm con TD:Text-Base sao không sử dụng Prop TextAlignmentPoint cho gọn. Mình nghĩ tốc độ sẽ nhanh hơn vì không phải kiểm tra If và setq chi cả

4./ Mình cũng chưa hiểu ý đồ của bạn lắm. Banj có thể post file lên thì mọi người mới có góp ý cụ thể được


  • 0

#1803 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 03:11 PM

Mình có mấy góp ý sau:

1./ Đã sử dụng hàm entmake vẽ POLYLINE thì không cần phải tắt chế độ bắt điểm. Vì khi tạo đối tượng bằng entmake thì không phụ thuộc vào chế độ bắt điểm

2./ Nên sử dụng hàm Repeat để lặp khi biết trước số lần lặp, không nên dùng While vì dùng While thì cứ mỗi lần lặp thì phải kiểm tra điều kiện lặp (mục đích đẩy nhanh tốc độ)

3./ Hàm con TD:Text-Base sao không sử dụng Prop TextAlignmentPoint cho gọn. Mình nghĩ tốc độ sẽ nhanh hơn vì không phải kiểm tra If và setq chi cả

4./ Mình cũng chưa hiểu ý đồ của bạn lắm. Banj có thể post file lên thì mọi người mới có góp ý cụ thể được

1. Dạ vâng. Do thói quen nên em cho vào chứ em cũng hiểu Entmake ko phụ thuộc vào OSNAP

2. Dạ, em sẽ rút kinh nghiệm. Cơ mà em cũng có ý là while với điều kiện thì thoát, ko phải chạy hết

3. Hàm em tự tạo để lấy điểm chuẩn của Text

4. Em làm về Trắc Địa nên khi đo địa hình về mng thường nối các điểm bằng 2D Polyline. Em viết hàm này mục đích để không phải vẽ lại các đường 3D Polyline. Các đường này sẽ là đường Break Line để chạy mặt cắt địa hình.

Thuật toán là tại các đỉnh Pline xét toàn bộ các Text, tính khoảng cách từ điểm đó đến các text, sort các khoảng cách đó và lấy ra phần tử đầu tiên.

Nếu tọa độ đỉnh đó trùng với tọa độ Text nào đó thì lấy ra tọa độ Text đó, nếu ko thỏa mãn thì giữ nguyên độ cao đỉnh đó.

Thuật toán chậm là do xét quá nhiều Text. Em nghĩ sẽ có cách khác nhanh hơn.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1804 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 23 August 2014 - 03:38 PM

1. Dạ vâng. Do thói quen nên em cho vào chứ em cũng hiểu Entmake ko phụ thuộc vào OSNAP

2. Dạ, em sẽ rút kinh nghiệm. Cơ mà em cũng có ý là while với điều kiện thì thoát, ko phải chạy hết

3. Hàm em tự tạo để lấy điểm chuẩn của Text

4. Em làm về Trắc Địa nên khi đo địa hình về mng thường nối các điểm bằng 2D Polyline. Em viết hàm này mục đích để không phải vẽ lại các đường 3D Polyline. Các đường này sẽ là đường Break Line để chạy mặt cắt địa hình.

Thuật toán là tại các đỉnh Pline xét toàn bộ các Text, tính khoảng cách từ điểm đó đến các text, sort các khoảng cách đó và lấy ra phần tử đầu tiên.

Nếu tọa độ đỉnh đó trùng với tọa độ Text nào đó thì lấy ra tọa độ Text đó, nếu ko thỏa mãn thì giữ nguyên độ cao đỉnh đó.

Thuật toán chậm là do xét quá nhiều Text. Em nghĩ sẽ có cách khác nhanh hơn.

 

1. Dạ vâng. Do thói quen nên em cho vào chứ em cũng hiểu Entmake ko phụ thuộc vào OSNAP

2. Dạ, em sẽ rút kinh nghiệm. Cơ mà em cũng có ý là while với điều kiện thì thoát, ko phải chạy hết

3. Hàm em tự tạo để lấy điểm chuẩn của Text

4. Em làm về Trắc Địa nên khi đo địa hình về mng thường nối các điểm bằng 2D Polyline. Em viết hàm này mục đích để không phải vẽ lại các đường 3D Polyline. Các đường này sẽ là đường Break Line để chạy mặt cắt địa hình.

Thuật toán là tại các đỉnh Pline xét toàn bộ các Text, tính khoảng cách từ điểm đó đến các text, sort các khoảng cách đó và lấy ra phần tử đầu tiên.

Nếu tọa độ đỉnh đó trùng với tọa độ Text nào đó thì lấy ra tọa độ Text đó, nếu ko thỏa mãn thì giữ nguyên độ cao đỉnh đó.

Thuật toán chậm là do xét quá nhiều Text. Em nghĩ sẽ có cách khác nhanh hơn.

1). Nếu đơn giản chỉ là cái màu đỏ thì em đã quá phức tạp hóa vấn đề. Anh đề xuất thuật toán như sau:

Tại mỗi đỉnh của 2DPolyline, ví dụ nó là pt, dùng (setq ss (ssget "c" pt pt '((0 . "Text")))) để chọn text.

Nếu có ss thì thay đỉnh, nếu không có ss thì giữ nguyên đỉnh.

2). Cách lấy tọa độ đỉnh 2DPolyline của em đã bị sai.


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


#1805 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 04:00 PM

1). Nếu đơn giản chỉ là cái màu đỏ thì em đã quá phức tạp hóa vấn đề. Anh đề xuất thuật toán như sau:

Tại mỗi đỉnh của 2DPolyline, ví dụ nó là pt, dùng (setq ss (ssget "c" pt pt '((0 . "Text")))) để chọn text.

Nếu có ss thì thay đỉnh, nếu không có ss thì giữ nguyên đỉnh.

2). Cách lấy tọa độ đỉnh 2DPolyline của em đã bị sai.

1. Đỏ: Liệu có liên quan đến vấn đề ZOOM ko bác Hạ? Em đã nghĩ tới cách bác nói trong câu hỏi lần trước. Bác cho em lời khuyên với ạ

2. Xanh: Bác chỉ cho em với ạ? Em thấy nó chạy đúng mà.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1806 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 04:18 PM

À, Ok. Cái số 2 em hiểu rồi.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1807 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 23 August 2014 - 04:25 PM

thanhduan2407:

1. nó liên quan den zoom, bạn nên chọn theo cách bạn đã làm ở bài #1790

2. Bạn dùng 1 trong 2 cách sau:

 (acet-geom-vertex-list ss)) - lấy được tất cả các đỉnh kể cả đa giác kín

(mapcar 'cdr(vl-remove-if-not'(lambda (x) (= (car x) 10))(entget ss))) - đa giác kín thì thiếu điểm cuối cùng

 

Vết cắt địa hình của bạn là 1 đường thẳng hay là đường gấp khúc

 

Doanvanha: mình nhớ bạn có đặt câu hỏi làm sao để chọn các point, text,.. gần điểm pt nhất 1 cách nhanh nhất (mình đã tìm lại nhưng không thấy đâu). Câu trả lời này chắc giúp được cho thanhduan2047. Không biết Ha đã có thuật toán giải quyết vấn đề này chưa vì mình cũng đang tìm hiểu


  • 1

#1808 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 04:51 PM

Cảm ơn bác Tien2005.

Em sẽ chọn cách cũ thôi ạ.

Em sẽ chờ phương án các bác thảo luận đưa ra.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1809 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 August 2014 - 05:12 PM

Sao lại foreach mà không phải là while not nhỉ :)

Bài toán còn nhanh hơn nữa nếu vl-sort cả list pt và list text base cùng chung 1 quy luật sắp xếp, hoặc gom nhóm theo độ chênh tọa độ , sau đó mới dùng vòng lặp.

Chém chém chém ^^


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#1810 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 23 August 2014 - 05:23 PM

Sơ ý dùng foreach nên delete ngay rồi. Dùng while sẽ có "thần may mắn" giúp đỡ hơ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.


#1811 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 05:29 PM

Hề hề. Cách làm của bác Hạ sẽ bị sai và lâu. he he.

Với lại cái cho equal p pt là sai vì nó có pt có cao độ.

@Ketxu: Em có ý tưởng nào không?

Viết dùm anh nghen.

Anh tham khảo cũng được. Bài toán sẽ áp dụng rất nhiều đấy. Hiii  :wub:

 (if (equal pt p 1E-8)
   p

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1812 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 05:32 PM

(setq lst (acet-ss-to-list (ssget "_X" '((0 . "text")))))

(setq lst_pt (mapcar '(lambda(ent) (cdr (assoc 10 (entget ent)))) lst))

Cái đấy của bác Hạ sẽ sai base của Text nếu Justify của Text khác nhau. :D


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1813 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 23 August 2014 - 05:34 PM

Tôi đã delete ngay sau khi đăng rồi còn gì!


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


#1814 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 05:35 PM

Em tìm được cái này hay quá nhưng nó lại là sách. Tìm được quyển này thì hay, cơ mà đắt quá.

http://www.cs.stonyb...-neighbor.shtml


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1815 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 05:36 PM

Tôi đã delete ngay sau khi đăng rồi còn gì!

Hì hì. Em copy về nghịch ngay í mờ. Sorry bác. :D


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1816 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 23 August 2014 - 06:36 PM

Em tìm được cái này hay quá nhưng nó lại là sách. Tìm được quyển này thì hay, cơ mà đắt quá.

http://www.cs.stonyb...-neighbor.shtml

Bán rẻ cho em đây!

http://sist.sysu.edu...esignManual.pdf


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


#1817 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 06:57 PM

Quý hóa quá. Cảm ơn bác Hạ nhiều. Bác có nhiều tài liệu hay ghê.

Cho em tham lam 1 chút nữa được không ạ?

Em đang nghiên cứu về tạo vùng Topology trong Autocad.

Đầu vào là các LINE nối với nhau thành các vùng kín và không kín.

Việc tạo Topology này là nếu vùng nào có Line nối khép kín với nhau thì tóm được các đỉnh thuộc vùng đó cho vào 1 danh sách. Nếu có n vùng thì có n danh sách các điểm của vùng.

Đây là bài toán rất hay trong Trắc Địa bác Hạ ạ!

Em đang làm đến bước khoanh vùng thì bị dừng lại do thuật toán chưa hiểu trong VB

(em đọc Code từ VB và muốn biến nó thành trong Autocad)

Nhờ các bác tư vấn cho em.

Function KhoanhVung(Ds_TopoEdges() As TopoEdge, TopoEdgesCount As Long, Ds_Areas() As Area, Areascount As Long, DS_Points() As Point_3D)
    Dim i As Long, j As Long
    Dim P1 As Point_3D, P2 As Point_3D
    Dim Id1 As Long, Id2 As Long, Ido As Long, K As Long
    Dim idCount As Long
    For i = 1 To TopoEdgesCount
        Ds_TopoEdges(i).Flag = False
    Next
    For i = 1 To TopoEdgesCount
    'Khoi tao vung
        If Ds_TopoEdges(i).Flag = False Then
            Ds_TopoEdges(i).Flag = True
            Id1 = Ds_TopoEdges(i).Id1
            Id2 = Ds_TopoEdges(i).Id2
            Ido = Id1
            Areascount = Areascount + 1
            ReDim Preserve Ds_Areas(Areascount)
            idCount = 0
            Do
                idCount = idCount + 1
                ReDim Preserve Ds_Areas(Areascount).Ds_Id(idCount)
                Ds_Areas(Areascount).Ds_Id(idCount) = Id1
                
                K = GetEdge(Id2, Id1, Ds_TopoEdges, TopoEdgesCount)
                If K < TopoEdgesCount Then
                    If Ds_TopoEdges(K + 1).Id1 = Id2 Then
                        K = K + 1
                    Else
                        For j = K To 1 Step -1
                            If Ds_TopoEdges(j).Id1 <> Id2 Then
                                K = j + 1
                                Exit For
                            End If
                        Next
                    End If
                Else
                    For j = K To 1 Step -1
                        If Ds_TopoEdges(j).Id1 <> Id2 Then
                            K = j + 1
                            Exit For
                        End If
                    Next
                End If
                Id1 = Ds_TopoEdges(K).Id1
                Id2 = Ds_TopoEdges(K).Id2
                Ds_TopoEdges(K).Flag = True
                If Id2 = Ido Then
                    idCount = idCount + 1
                    ReDim Preserve Ds_Areas(Areascount).Ds_Id(idCount)
                    Ds_Areas(Areascount).Ds_Id(idCount) = Id1
                    Ds_Areas(Areascount).idCount = idCount
                    Exit Do
                End If
            Loop
'TÝnh diÖn tÝch vïng
'C¸ch 1
'                    Dim PL As PolyLine_3D
'                    .Dientich = 0
'                    For j = 1 To Areascount - 1
'                        PL = CoverAreaToPlLine(DS_Areas(j))
'                        .Dientich = GetArea(PL)
'                    Next
'C¸ch 2
            With Ds_Areas(Areascount)
                    Dim DX As Double, YTB As Double
                    .Dientich = 0
                    For j = 1 To .idCount - 1
                        DX = DS_Points(.Ds_Id(j + 1)).rX - DS_Points(.Ds_Id(j)).rX
                        YTB = (DS_Points(.Ds_Id(j + 1)).rY + DS_Points(.Ds_Id(j)).rY) / 2
                        .Dientich = .Dientich + DX * YTB
                    Next
                    DX = DS_Points(.Ds_Id(1)).rX - DS_Points(.Ds_Id(.idCount)).rX
                    YTB = (DS_Points(.Ds_Id(1)).rY + DS_Points(.Ds_Id(.idCount)).rY) / 2
                    .Dientich = Format((.Dientich + DX * YTB), "0.00")
'TÝnh t©m vïng
                    For j = 1 To .idCount
                        .Po.rX = .Po.rX + DS_Points(.Ds_Id(j)).rX
                        .Po.rY = .Po.rY + DS_Points(.Ds_Id(j)).rY
                    Next
                    .Po.rX = .Po.rX / .idCount
                    .Po.rY = .Po.rY / .idCount
                    If .Dientich > 0 Then
                        SoTamVung = SoTamVung + 1
                        ReDim Preserve Ds_Tam(SoTamVung)
                        Ds_Tam(SoTamVung).Po.rX = .Po.rX
                        Ds_Tam(SoTamVung).Po.rY = .Po.rY
                    End If
                End With
        End If
    Next
End Function

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1818 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 23 August 2014 - 10:28 PM

Cách diễn đạt bài toán của em hơi khó hiểu.

Có thể diễn đạt dễ hiểu hơn không? File cad minh họa?


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


#1819 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 10:40 PM

Dạ đây ạ.

Sau khi tạo vùng xong thì ta  lấy được 1 danh sách các vùng.Mỗi vùng chứa các đỉnh.

Cái vòng tròn màu vàng là đánh dấu vùng tạo được topology.

1 bài toán trong Địa Chính bác Hạ ạ

 

http://www.cadviet.c...65_topology.dwg


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1820 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 04 September 2014 - 04:23 PM

Tôi nhớ mang máng là hình như có đọc đâu đó vấn đề này rồi, nhưng giờ quên mất.

Hỏi: tôi load 1 file lisp xong. Vậy có thể lấy được đường dẫn đến file lisp vừa load đó không?

Ai biết nhờ chỉ giùm. Thanks!


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