[Yêu Cầu] Cắm Cọc Gpmb Trên 2 Mép Ngoài Taluy Trên Bình Đồ

[hiepttr 538]

Vấn đề của bạn được giải quyêt như sau:

- Nếu không join được thì có thể F với R=0, chú ý chọn đúng "cạnh" của PL. Nếu góc tạo bởi 2 "cạnh" đầu-cuối của 2 PL = k*pi thì phải chọn 1 trong 2 và "cạnh" tiếp theo ...

- Sau khi đã join thành công rồi, chạy lisp, chọn 2 đường mép taluy xong, chọn tùy chọn F rồi "vẽ" theo đường tim để lisp xuất cọc đúng thứ tự.

Chúc bạn thành công ! :D

[dangky2510 6]

- Em thử dùng cách của anh thấy có đoạn thì nối được có đoạn thì lại không, anh có thể giải thích thêm về góc của 2 cạnh đầu cuối PL = k*pi nghĩa là như thế nào ạ?
- Khi vẽ đường tim có cần thiết phải vẽ đúng vị trí đường tim không hay là chỉ cần chọn điểm đầu và cuôí tuyến thôi?

- Mà em thấy đường pline của em còn có nhiều vertex là các layer khác liệu có phải là nguyên nhân không bác?

[hiepttr 538]

- ...góc của 2 cạnh đầu cuối PL = k*pi ... Có nghĩa là 2 "cạnh" này nằm trên một đường thẳng >>> Khi đó lệnh FILLET của cad không thực hiện được (đúng ý đồ).

- Nói vẽ đường tim chỉ là cách nói cho dễ hiểu, thực chất là phương thức chọn Fence (hàng rào), cad sẽ chọn lần lượt từ đầu đến cuối các đối tượng mà đường "gạch gạch" cắt qua >>>> không cần vẽ đúng vị trí đường tim mà vẽ sao cho đường "gạch gạch" cắt qua các line ENTCOC là được.

[dinhnk2015 0]

xin chào các anh các bạn.

em mới học cad được thời giàn rồi. hôm nay em gặp vẫn đề mong mọi người giúp đỡ.

Em vẽ tren A2 với tỉ lệ 1:1.sau khi in em đo thục thế tren giấy thì không đúng với kích thước.

Cụ thể là trong bản vẽ có kích thước 160 nhung khi đo thưc tế chỉ là 155

Trước khi vẽ em đã chon metricssau đó mvsetup, trong bảng dim đã fit rồi

Mọng mọi người giúp đỡ

[dangky2510 6]

- ...góc của 2 cạnh đầu cuối PL = k*pi ... Có nghĩa là 2 "cạnh" này nằm trên một đường thẳng >>> Khi đó lệnh FILLET của cad không thực hiện được (đúng ý đồ).

- Nói vẽ đường tim chỉ là cách nói cho dễ hiểu, thực chất là phương thức chọn Fence (hàng rào), cad sẽ chọn lần lượt từ đầu đến cuối các đối tượng mà đường "gạch gạch" cắt qua >>>> không cần vẽ đúng vị trí đường tim mà vẽ sao cho đường "gạch gạch" cắt qua các line ENTCOC là được.

Sau khi fillet bằng 1 trong 2 cạnh tiếp theo thì những cạnh trước lại bị xóa đi như trong 2 đường pline trong file dưới đây của em. 

http://www.cadviet.com/upfiles/5/64560_11111.dwg

[tien2005 241]

Đoạn PL bên phải của Bạn có các canh trùng nhau nên nối không được

khắc phục: explode đoạn PL bên phải, dùng overkill để loại bỏ các line trùng, dùng PE để join lại là OK

[dangky2510 6]

Hì hì em cũng thử explode và cũng phát hiện ra nhiều đường trùng nhau, nhưng e chỉ xóa thủ công thì nối ko được. N có cái lệnh OVERKILL là lại ổn rồi bác tien2005.

Thank bác!

[hiepttr 538]

Mình đã thử nối PL của bạn, lường trước rằng bạn sẽ bị vướng chổ này nên mới có đoạn: "Nếu góc tạo bởi 2 "cạnh" đầu-cuối của 2 PL = k*pi thì phải chọn 1 trong 2 và "cạnh" tiếp theo ..."

Có nghĩa là bạn Fillet với R=0, 2 điểm chọn tại 2 point như file đính kèm

Có lẻ là do mình diễn giải chưa được rõ :D :D :D

http://www.cadviet.com/upfiles/5/80156_note.dwg

[dangky2510 6]

- Khi bác giải thích góc = k*pi (tức là bội của 180 độ) thì em hiểu rồi, em cũng tick như trong file bác hướng dẫn, nhưng khi tick chọn 2 điểm đó thì các đường pline phía bên phải bị xóa đi 1 phần như trong file dưới đây ạ. 

http://www.cadviet.com/upfiles/5/64560_80156_note_1.dwg

 

- Mà lỗi khi xuất ra thứ tự cọc không đúng là do đường mép taluy có nhiều đối tượng trùng nhau nên mới bị lỗi đấy ý bác ạ, sau khi em overkill và nối lại toàn bộ 2 mép taluy trái phải thì thấy thứ tự cọc xuất ra không sai nữa (khi đấy em vẫn chưa dùng fence).

- Bác xem hộ em tại sao khi line entencoc giao đúng chỗ điểm gấp khúc trên 2 line meptlt và meptlp thì không chạy được lisp. Đây là 1 đoạn bị lỗi trên bình đồ em ạ.

http://www.cadviet.com/upfiles/5/64560_2222.dwg

[hiepttr 538]

- Mình vẫn nối bằng F với R=0 được mà !? :D Chắc là điểm pick của bạn đúng ngay đoạn line "quay đầu trở lại" :D

Nhưng thôi, bạn đã có overkill ...

 

- Mình đã nói là thứ tự cọc xuất ra phụ thuộc và thứ tự các line ENTCOC khi chọn đối tượng, vì trong thuật toán mình viết, mỗi lần xét giao để đóng cọc mốc chỉ xét cho 1 line ENTCOC và 1 đường biên nên cái "thứ tự này" nó ko liên quan gì đến overkill.

Bạn không tin, có thể thử chọn tùm lum thứ tự cọc xem nó xuất ra thế nào ??? :D :D :D

 

- Lisp chạy lỗi ko phải do điểm gấp khúc mà do có 1 line ENTCOC tại TD98 không giao với MEPTLP, bạn chỉ cần EXTEND đường MEPTLP ra để có điểm giao là OK !

[dangky2510 6]

- Lạ thật, em pick theo cả 2 kiểu point màu trắng và màu đỏ như bác hướng dẫn nhưng kiểu nào pline bên phải cũng bị xóa 1 phần.

 

- Đúng thế thật bác ạ, lúc trước e xuất ra đúng vì em lựa chọn line ENTCOC từ trái tuyến sang.

 

- Chỗ TD98 đấy thì do em cắt bình đồ không để ý, nhưng khi chạy trên tuyến đầy đủ chỗ P96, TC96 và nhiều điểm khác nữa bị lỗi bác ạ, hình như ko nhận điểm giao MEPTLT. Em up file đầy đủ bác xem hộ em với ạ.

http://www.cadviet.com/upfiles/5/64560_2222_1.dwg

[hiepttr 538]

1; 2. Không bàn nữa :D

3. Đã fix :

(defun c:DONG4 ( / lst_va old ss lst_name coc tlt tlp ob trai phai mid mid_pt fn pw ten_coc)
(vl-load-com)
(defun mid(p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nChon BD muon dong coc GPMB !")
(setq ss (ssget '((8 . "MEPTLT,MEPTLP,ENTCOC"))))
(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq coc (vl-remove-if-not '(lambda(x) (= "ENTCOC" (cdr (assoc 8 (entget x))))) lst_name)
	  tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
	  tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,Ten coc,Trai,,,Phai" pw)
(write-line ",,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
(foreach c coc
	(setq ten_coc	(cdr 
						(car
							(vl-remove-if-not '(lambda (x) (= 1000 (car x))) (cdr (last (assoc -3 (entget c '("*"))))))
						)
					)
	)
	(setq 	mid_pt (mid (vlax-curve-getStartpoint c) (vlax-curve-getEndpoint c))
			trai (car (vl-sort (H:inter-group3 (setq ob (vlax-ename->vla-object c)) tlt) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
			phai (car (vl-sort (H:inter-group3 ob tlp) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
	)
	(command "_.insert" "cocmoc" trai 1 "" "")
	(command "_.insert" "cocmoc" phai 1 "" "")
	(command ".DIMALIGNED" mid_pt trai (mid trai mid_pt))
	(command ".DIMALIGNED" mid_pt phai (mid phai mid_pt))
	(write-line (strcat "," ten_coc "," (rtos (distance mid_pt trai) 2 3) "," (rtos (cadr trai) 2 3) "," (rtos (car trai) 2 3)
									"," (rtos (distance mid_pt phai) 2 3) "," (rtos (cadr phai) 2 3) "," (rtos (car phai) 2 3)) pw)
)
(close pw)
(mapcar 'setvar lst_va old)
(princ)
)
;;;;
(defun H:inter-group3(ob1 ob2 / modul res)
(cond 
	((null (setq modul (vlax-invoke ob1 'intersectwith ob2 acExtendThisEntity))) nil)
	((= (length modul) 3) (list modul))
	(t 
		(while (> (length modul) 0)
			(setq	res (cons (list (car modul) (cadr modul) (caddr modul)) res)
					modul (cdddr modul)
			)
		)
		(reverse res)
	)
)
)

[dangky2510 6]

- Hì hì mượt mà như da em bé rồi bác ơi! Thank bác nhiều nhé

[dangky2510 6]

Xin phép lại làm phiền bác "hiepttr" tý nhé. Tất cả các bình đồ thiết kế bằng NOVA thì chạy ngon lành cành đào. Nhưng khi bình đồ thiết kế bằng VNROAD như bình đồ dưới đây em gửi có 1 số vấn đề sau ạ. 

  1. Trên bình đồ chỗ cắm cọc được chỗ thì không có.

  2. File xuất ra không có dữ liệu gì cả.

Em gửi file bác xem hộ em phát nhé, Thank bác!

http://www.cadviet.com/upfiles/5/64560_bi_loi.dwg

[hiepttr 538]

Mình đã nói từ trước là lisp này lấy tên cọc từ dữ liệu Xdata nên với BD bạn gửi thì nó bị "mù" không biết tên cọc >>> sai là điều tất nhiên :D :D :D

 

Không biết thằng VNROAD nó giấu tên cọc ở đâu, với cái bình đồ mà bạn gửi mình ko có cách nào để tìm thấy tên cọc cả :D

[dangky2510 6]

Bình đồ gốc của em đây bác. Bác xem hộ em với, với cả không cắm được cọc và kích thước nữa.

http://www.cadviet.com/upfiles/5/64560_binh_do_goc.dwg

[dangky2510 6]

Bác kiểm tra hộ em xem tại sao mà khi chạy lisp chỉ 1 vài vị trí là cắm được cọc và kích thước, còn lại đa số là không chạy được. Còn cọc entcoc không có dữ liệu Xdata thì em có thể làm thủ công cũng được ạ. File bản vẽ em up ở bài trên nhé.

[hiepttr 538]

Srr bạn, hôm nay mình vừa đi ra công trường về.

Bình đồ bạn gửi có đường PL MEPTLP có cao độ >0 ===>>> chuyển nó về =0 thì cắm được cọc & ghi dim.

Riêng "vụ tự nhận tên cọc" chắc phải lấy từ text tên cọc thôi, rảnh mình sẽ sửa cho bạn

[dangky2510 6]

Ui em mong bác mãi hì. À bản này em quên chưa chuyển, em chuyển z về 0 rồi nhưng khi chạy cũng chỉ chạy được vài cọc thôi bác ạ. Trường hợp mà không lấy được tên cọc bác có thể sửa thành cọc xuất ra theo thứ tự 1,2,3... giúp em sau khi xuất ra được rồi em có thể thay tên cọc thủ công cũng được ạ.

Sau khi em đưa về Z=0: http://www.cadviet.com/upfiles/5/64560_binh_do_goc_1.dwg

Lisp gần nhất bác sửa cho em: http://www.cadviet.com/upfiles/5/64560_gpmbbd6_co_kich_thuoc_xuat_bang_toa_do.lsp

Lisp đưa về Z =0: http://www.cadviet.com/upfiles/5/64560_ve0.lsp

[hiepttr 538]

Rảnh >>> lại dâng sớ đây :D :D :D

Với BD bạn gửi lên:

- Chuyển Elevation của MEPTLP về 0

- Match tất cả line text tên cọc về layer "Texttencoc"

- EX để kéo dài: tim, MEPTLP, MEPTLT vượt qua  ENTCOC đầu và cuối

- Copy/ Paste block cocmoc (define block)

 

>>> Ap lisp >>> DONG5    :D

(defun c:DONG5 ( / lst_va old ss_coc ss lst_name tim tlt tlp lst_ten_coc lst_coc mid_pnt ten find ob trai phai mid_pt fn pw)
;
(vl-load-com)
;
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nQuet chon BD de lay ten coc !")
(setq ss_coc (ssget '((0 . "LINE") (8 . "Texttencoc"))))
(if ss_coc 
	(progn
		(princ "\n Chon MEPTLT, MEPTLP, tim tuyen !")
		(setq ss (ssget '((8 . "MEPTLT,MEPTLP,TUYEN"))))
		(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
		(setq tim (car (vl-remove-if-not '(lambda(x) (= "TUYEN" (cdr (assoc 8 (entget x))))) lst_name))
			tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
			tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
		(command ".zoom" "o" ss_coc "")
		(setq	lst_ten_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_coc)))
				lst_ten_coc (mapcar '(lambda (x) (list x (get_text_coc x 4.5 13))) lst_ten_coc))
		(setq lst_coc (ssget "_F" (lst_point_fence tim) '((0 . "LINE") (8 . "ENTCOC"))))
		(setq lst_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex lst_coc))))
		(setq lst_coc 
			(mapcar 
				'(lambda (x) 
					(setq	mid_pnt (mid (vlax-curve-getStartpoint x) (vlax-curve-getEndpoint x))
							i 0)
					(while (< i (length lst_ten_coc))
						(if (setq find (find_piles (car (setq ten (nth i lst_ten_coc))) mid_pnt 50)) (setq i (length lst_ten_coc)) (setq i (1+ i)))
					)	   ;while
					(if find (list x mid_pnt (last ten)) (list x mid_pnt "No name"))
				)
				lst_coc)
		)
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT,Ten coc,Trai,,,Phai" pw)
		(write-line ",,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
		(foreach c lst_coc
			(setq 	mid_pt (cadr c)
					trai (car (vl-sort (H:inter-group3 (setq ob (vlax-ename->vla-object (car c))) tlt) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
					phai (car (vl-sort (H:inter-group3 ob tlp) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
			)
			(command "_.insert" "cocmoc" trai 1 "" "")
			(command "_.insert" "cocmoc" phai 1 "" "")
			(command ".DIMALIGNED" mid_pt trai (mid trai mid_pt))
			(command ".DIMALIGNED" mid_pt phai (mid phai mid_pt))
			(write-line (strcat "," (last c) "," (rtos (distance mid_pt trai) 2 3) "," (rtos (cadr trai) 2 3) "," (rtos (car trai) 2 3)
											"," (rtos (distance mid_pt phai) 2 3) "," (rtos (cadr phai) 2 3) "," (rtos (car phai) 2 3)) pw)
		)
		(close pw)
	)
	(princ "\nKhong chon duoc line ten coc !")
)
(mapcar 'setvar lst_va old)
(princ)
)
;;;==============================================================
(defun mid (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
;;;;==============================================================
(defun H:inter-group3(ob1 ob2 / modul res)
(cond 
	((null (setq modul (vlax-invoke ob1 'intersectwith ob2 acExtendThisEntity))) nil)
	((= (length modul) 3) (list modul))
	(t 
		(while (> (length modul) 0)
			(setq	res (cons (list (car modul) (cadr modul) (caddr modul)) res)
					modul (cdddr modul)
			)
		)
		(reverse res)
	)
)
)
;;;;===================================================================
(defun lst_point_fence (pl / info lst_bug lst_point i arc_len fence)
(setq	info (entget pl '("*"))
		lst_bug (vl-remove-if-not '(lambda(x) (= 42 (car x))) info)
		lst_point (vl-remove-if-not '(lambda(x) (= 10 (car x))) info)
		i 0)
(while (< i (length lst_bug))
	(cond 
		((/= 0 (cdr (nth i lst_bug)))
			(setq	fence (cons (cdr (nth i lst_point)) fence)
					arc_len (abs (- (setq start (vlax-curve-getDistAtPoint pl (cdr(nth i lst_point)))) (vlax-curve-getDistAtPoint pl (cdr (nth (setq i (1+ i)) lst_point)))))
					
			)
			(repeat 3 
				(setq 	fence (cons (vlax-curve-getPointAtDist pl (setq start (+ start (/ arc_len 4)))) fence))
			)
		)
		(t (setq 
				fence (cons (cdr (nth i lst_point)) fence)
				i (1+ i))
		)
	)
)
(reverse fence)
)
;;;===============================================================
(defun get_text_coc (ent h w / info dau_line cuoi_line pt1 pt2 pt3 pt4 ss)
;ham lay text ten coc thuoc layer "Texttencoc" khi co line vach chi gan text
;h, w: chieu cao, rong cuar window vung chon
(setq	dau_line (cdr (assoc 10 (setq info (entget ent))))
		cuoi_line (cdr (assoc 11 info))
		pt1 (polar cuoi_line (+ (setq ang_line (angle dau_line cuoi_line)) (* 0.5 pi)) (* 0.5 w))
		pt2 (polar pt1 ang_line h)
		pt3 (polar pt2 (- ang_line (* 0.5 pi)) w)
		pt4 (polar cuoi_line (- ang_line (* 0.5 pi)) (* 0.5 w))
)
(setq ss (ssget "_WP" (list pt1 pt2 pt3 pt4) '((0 . "TEXT") (8 . "Texttencoc"))))
(if ss (cdr (assoc 1 (entget (ssname ss 0)))) "No_name")
)
;;;===================================================================
(defun find_piles (line_piles_name pnt_piles lim / st end)
;Tu line ten coc, tim thay point tim coc trong gioi han khoang cach (dien ten coc)
(setq	st (vlax-curve-getStartpoint line_piles_name)
		end (vlax-curve-getEndpoint line_piles_name))
(if (and (<= (distance end pnt_piles) lim) (equal (angle end st) (angle end pnt_piles) 1e-3)) T)
)

p/s:

Vì mình trình còn non, code theo kiểu luyện bài cũ >>> Lisp này chủ yếu để chạy trên bản vẽ này, trên bản khác thì có thể phát sinh lỗi ngay nếu không hiệu chỉnh một vài thứ :D

[dangky2510 6]

Căm cọc và dim lại ngon rồi bác ạ, nhưng có 1 số cọc trong file xuất ra hiện chữ "noname" nghĩa là đường line texttencoc đấy ko có tên cọc à bác? Em thấy dùng lisp này có phần nhanh hơn dong4 vì không phải kéo đường fence nữa.

P.s: Em chỉ mong em được trình non như bác, n mỗi tội lười học với cả cũng không dùng đến nhiều :D

[hiepttr 538]

.................... nhưng có 1 số cọc trong file xuất ra hiện chữ "noname" nghĩa là đường line texttencoc đấy ko có tên cọc à bác? ..........

Bạn đang chạy cho BD bạn gửi lên hay BD khác thì xảy ra lỗi ?

Ý đồ của mình trong code:

- Nếu từ line có layer "texttencoc" tìm không ra text chứa tên cọc thì trả lại kết quả tên cọc là "No_name" (có gạch ngang)

- Nếu từ line có layer "ENTCOC" tìm không ra line có layer "texttencoc" tương ứng trong phạm vi khoảng cách "lim" thì trả lại kết quả tên cọc là "No name" (không có gạch ngang)

>>>> Các cọc đã xuất ra đúng thứ tự, nên bạn có thể kiểm tra lại BD.

VD:

+ Tại cọc 100, không tìm thấy line có layer "texttencoc" tương ứng >>>> bạn cần match line (gần text tên cọc) về layer "texttencoc"

+ Tại cọc TD71; P38; TC74..., text tên cọc bị dời lệch (không thẳng hàng với line ENTCOC) >>> MOVE về cho thẳng

 

p/s: Mình đã sửa code (tăng giá trị phạm vi tìm texttencoc) >>> bạn down lại tại #45 nhé !

Chúc vui ! :D

[dangky2510 6]

Bình đồ em gửi bên trên em làm theo bác thì OK, nhưng bình đồ dưới đây em kiểm tra theo 2 trường hợp của bác đều đảm bảo nhưng vẫn hiện ra no_name ạ.

http://www.cadviet.com/upfiles/5/64560_test.dwg

http://www.cadviet.com/upfiles/5/64560_test.zip

[hiepttr 538]

Lỗi xảy ra vẫn vì 2 lý do đó :D

-  Lỗi No_name: ".. từ line có layer "texttencoc" tìm không ra text chứa tên cọc "   : Ở đây, lisp tìm có quy luật: Tìm trong ô chọn hình chữ nhật phía End point của line Texttencoc; Ô chọn có kích thước xác định tại ......(get_text_coc x 6 13)... (trong code mình post ở dưới _ trước đó là ...(get_text_coc x 4.5 13)..)

>>>> Các line không đúng quy tắc (tức đưa Start point về phía text tên cọc) sẽ bị lỗi do lisp chỉ tìm phía end point >>>> Phiền bạn đổi chiều các line đó trước khi chạy lisp.

Lý do: Mình có thể sửa code để nhận tên cả 2 đầu nhưng dễ gây ra lỗi nhận nhầm tên cọc.

- Lỗi No name: Là do:

1. Texttencoc lệch, VD: P50 ... >>>> Fix: Đã sửa để lisp chấp nhận một khoảng lệch ~ 0.1 m ứng với khoảng cách điền cọc cách tim tuyến ~15m.

>> Khoảng lệch lớn hơn bạn phải chỉnh lại.

2. Trong code cũ, mình chỉ tìm cọc tương thích với tên cọc theo 1 chiều (từ end point đến Start point của line Texttencoc)

>>>> Đã fix tìm theo 2 chiều (Dư nhưng chứng minh được điều mình nói :D  )

(defun c:DONG5 ( / lst_va old ss_coc ss lst_name tim tlt tlp lst_ten_coc lst_coc mid_pnt ten find ob trai phai mid_pt fn pw)
;
(vl-load-com)
;
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nQuet chon BD de lay ten coc !")
(setq ss_coc (ssget '((0 . "LINE") (8 . "Texttencoc"))))
(if ss_coc 
	(progn
		(princ "\n Chon MEPTLT, MEPTLP, tim tuyen !")
		(setq ss (ssget '((8 . "MEPTLT,MEPTLP,TUYEN"))))
		(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
		(setq tim (car (vl-remove-if-not '(lambda(x) (= "TUYEN" (cdr (assoc 8 (entget x))))) lst_name))
			tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
			tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
		(command ".zoom" "o" ss_coc "")
		(setq	lst_ten_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_coc)))
				lst_ten_coc (mapcar '(lambda (x) (list x (get_text_coc x 6 13))) lst_ten_coc))
		(setq lst_coc (ssget "_F" (lst_point_fence tim) '((0 . "LINE") (8 . "ENTCOC"))))
		(setq lst_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex lst_coc))))
		(setq lst_coc 
			(mapcar 
				'(lambda (x) 
					(setq	mid_pnt (mid (vlax-curve-getStartpoint x) (vlax-curve-getEndpoint x))
							i 0)
					(while (< i (length lst_ten_coc))
						(if (setq find (find_piles (car (setq ten (nth i lst_ten_coc))) mid_pnt 35)) (setq i (length lst_ten_coc)) (setq i (1+ i)))
					)	   ;while
					(if find (list x mid_pnt (last ten)) (list x mid_pnt "No name"))
				)
				lst_coc)
		)
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT,Ten coc,Trai,,,Phai" pw)
		(write-line ",,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
		(foreach c lst_coc
			(setq 	mid_pt (cadr c)
					trai (car (vl-sort (H:inter-group3 (setq ob (vlax-ename->vla-object (car c))) tlt) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
					phai (car (vl-sort (H:inter-group3 ob tlp) '(lambda (x y) (< (distance x mid_pt) (distance y mid_pt)))))
			)
			(command "_.insert" "cocmoc" trai 1 "" "")
			(command "_.insert" "cocmoc" phai 1 "" "")
			(command ".DIMALIGNED" mid_pt trai (mid trai mid_pt))
			(command ".DIMALIGNED" mid_pt phai (mid phai mid_pt))
			(write-line (strcat "," (last c) "," (rtos (distance mid_pt trai) 2 3) "," (rtos (cadr trai) 2 3) "," (rtos (car trai) 2 3)
											"," (rtos (distance mid_pt phai) 2 3) "," (rtos (cadr phai) 2 3) "," (rtos (car phai) 2 3)) pw)
		)
		(close pw)
	)
	(princ "\nKhong chon duoc line ten coc !")
)
(mapcar 'setvar lst_va old)
(princ)
)
;;;==============================================================
(defun mid (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
;;;;==============================================================
(defun H:inter-group3(ob1 ob2 / modul res)
(cond 
	((null (setq modul (vlax-invoke ob1 'intersectwith ob2 acExtendThisEntity))) nil)
	((= (length modul) 3) (list modul))
	(t 
		(while (> (length modul) 0)
			(setq	res (cons (list (car modul) (cadr modul) (caddr modul)) res)
					modul (cdddr modul)
			)
		)
		(reverse res)
	)
)
)
;;;;===================================================================
(defun lst_point_fence (pl / info lst_bug lst_point i arc_len fence)
(setq	info (entget pl '("*"))
		lst_bug (vl-remove-if-not '(lambda(x) (= 42 (car x))) info)
		lst_point (vl-remove-if-not '(lambda(x) (= 10 (car x))) info)
		i 0)
(while (< i (length lst_bug))
	(cond 
		((/= 0 (cdr (nth i lst_bug)))
			(setq	fence (cons (cdr (nth i lst_point)) fence)
					arc_len (abs (- (setq start (vlax-curve-getDistAtPoint pl (cdr(nth i lst_point)))) (vlax-curve-getDistAtPoint pl (cdr (nth (setq i (1+ i)) lst_point)))))
					
			)
			(repeat 3 
				(setq 	fence (cons (vlax-curve-getPointAtDist pl (setq start (+ start (/ arc_len 4)))) fence))
			)
		)
		(t (setq 
				fence (cons (cdr (nth i lst_point)) fence)
				i (1+ i))
		)
	)
)
(reverse fence)
)
;;;===============================================================
(defun get_text_coc (ent h w / info dau_line cuoi_line pt1 pt2 pt3 pt4 ss)
;ham lay text ten coc thuoc layer "Texttencoc" khi co line vach chi gan text
;h, w: chieu cao, rong cuar window vung chon
(setq	dau_line (cdr (assoc 10 (setq info (entget ent))))
		cuoi_line (cdr (assoc 11 info))
		pt1 (polar cuoi_line (+ (setq ang_line (angle dau_line cuoi_line)) (* 0.5 pi)) (* 0.5 w))
		pt2 (polar pt1 ang_line h)
		pt3 (polar pt2 (- ang_line (* 0.5 pi)) w)
		pt4 (polar cuoi_line (- ang_line (* 0.5 pi)) (* 0.5 w))
)
(setq ss (ssget "_WP" (list pt1 pt2 pt3 pt4) '((0 . "TEXT") (8 . "Texttencoc"))))
(if ss (cdr (assoc 1 (entget (ssname ss 0)))) "No_name")
)
;;;===================================================================
(defun find_piles (line_piles_name pnt_piles lim / st end)
;Tu line ten coc, tim thay point tim coc trong gioi han khoang cach (dien ten coc)
(setq	st (vlax-curve-getStartpoint line_piles_name)
		end (vlax-curve-getEndpoint line_piles_name))
(if (and (<= (distance end pnt_piles) lim) (or (equal (angle end st) (angle end pnt_piles) 7e-3) (equal pi (abs (- (angle end st) (angle end pnt_piles))) 7e-3))) T)
)

[dangky2510 6]

-- Dạ thưa bác, thật sự em rất là nghiệm túc đọc giải thích ý đồ của bác trong lisp cũng hiểu được ý đồ của bác và cố đọc lisp xem ý đồ đó của bác thể hiện ở đoạn nào nhưng mà em không hiểu nổi :(. Chắc sau vụ này em nghiên cứu thêm món này để có thể hiệu chỉnh 1 vài thông số sao cho phù hợp với từng bài toán khác nhau.

- Quay lại chủ đề này, nếu như theo ý đồ của bác thì chắc lisp dong5 không thể hoàn thiện được như dong4 được, vì trên em nhiều đường miền núi nên thiết kế có nhiều đường cong con rắn nên bên tke thường thay đổi vị trí text tên cọc cho dễ nhìn và các text tên cọc cũng sát nhau đương nhiên phạm vi từ ENTCOC đến line texttencoc cũng thay đổi ko giống nhau trên toàn tuyến và trong phạm vi get_tex_coc sẽ có nhiều tên cọc bị trùng. Nhưng số lượng cọc thay đổi cũng không nhiều nên có thể làm thủ công cũng OK ạ. Em hiểu như vậy không biết có đúng không bác chỉ giáo thêm nhé.

- Đoạn lisp thay đổi phạm vi 15m đó ở đâu vậy bác, bác chỉ em với :D

P/s: Bác giúp em thêm vào lisp dong4, dong5 xuất ra thêm khoảng cách lẻ giữa các cọc với ạ, chính là khoảng cách giữa các cọc theo đường tim tuyến.