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

Tháng 12 1, 2015

- Cái DONG5 có hoàn thiện đưộc số liệu hay không là phụ thuộc vào BD của bạn có "ISO" hay không:

+ Các line có layer "Texttencoc" phải "tương đối" thẳng hàng với line ENTCOC tương ứng và có điểm đầu (start point) quay về phía tim tuyến; điểm cuối (end point) quay về phía text tên cọc

+ Các line có layer "Texttencoc" phải thỏa mãn cách tim tuyến < giá trị khai báo ở dòng:

..........(setq find (find_piles (car (setq ten (nth i lst_ten_coc))) mid_pnt 35)).......... _Khoảng cách này được tính từ điểm cuối của line đến tim tuyến.

+ Lấy điểm cuối (end point) của line có layer "Texttencoc" làm điểm chuẩn và hướng của chính line này làm hướng để xét thì: Trong phạm vi ô chọn phải tìm được Text tên cọc tương ứng

>> Trường hợp đường cong con rắn mảng xà :D >>> Bạn có quyền dời text tên cọc nhưng phải đảm bảo 3 yếu tố trên !

p/s1:

Tại #49 mình viết ...Đã 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...

Bạn đừng cắt riêng nó ra ý nghĩa nó kỳ lắm :D

Ý của mình là: Với trường hợp line Texttencoc cách tuyến 15 m thì chấp nhận 2line: Texttencoc & ENTCOC "lệch nhau" ~0.1m.

Thể hiện trong đoạn code: ...(or (equal (angle end st) (angle end pnt_piles) 7e-3) (equal pi (abs (- (angle end st) (angle end pnt_piles))) 7e-3)))...

Tháng 12 2, 2015

- Thank bác, hiểu lisp hơn thì em có thể hiệu chỉnh được bình đồ mình phù hợp với cả biết sai chỗ nào mà tự sửa ko lại cứ phải làm phiền bác mãi :D

- Bác có thể giải thích rõ hơn về giá trị "35" trong đoạn code "..........(setq find (find_piles (car (setq ten (nth i lst_ten_coc))) mid_pnt 35))..........", "35" ở đây được tính như thế nào mà thành khoảng cách từ tim tuyến đến line text tên cọc là 15m ạ?

- Còn đoạn " ...(or (equal (angle end st) (angle end pnt_piles) 7e-3) (equal pi (abs (- (angle end st) (angle end pnt_piles))) 7e-3)))..." thì giá trị "7e-3" được hiểu như thế nào là ~0,1m.

Em còn non mong bác chỉ giáo thêm :D

Lúc nào bác rảnh bác giúp em thêm cái khoảng cách lẻ giữa các cọc trong file xuất ra vào cả 2 lisp dong4, dong5 nhé.

Tháng 12 2, 2015

:D :D :D

1. Ở đoạn "..........(setq find (find_piles (car (setq ten (nth i lst_ten_coc))) mid_pnt 35))..........", "35" tức là lisp tìm line texttencoc trong k/c 35 m. Mình đâu nói là 15m. :D

2. Ở đoạn " ...(or (equal (angle end st) (angle end pnt_piles) 7e-3) (equal pi (abs (- (angle end st) (angle end pnt_piles))) 7e-3)))..." thì giá trị "7e-3" được hiểu: Nếu điền cọc cách tim tuyến 15m thì cái sai số cho phép "7e-3" tức 7*10^-3 radial >>> tương đương độ lệch khoảng cách là ~0.1m.

Hay nói cách khác: Lisp chấp nhận point tim cọc lệch hướng line Texttencoc "7e-3" radial.

Tháng 12 3, 2015

Bản vẽ không được ISO cho lắm nhưng có đến 90 cọc No_name tương đương 18% thì LISP cũng không tốt lắm,

tuy nhiên cũng chấp nhận được đối với LISP FREE.

Cách chọn WP cho text tên cọc hình như không hiệu quả lắm, nên thay bằng CP hay F và chọn cả 2 phía.

Cần xử lý trường hợp lỗi là không chọn hoặc chọn được nhiều đối tượng.

Tôi chưa test nhưng nhìn vào bản vẽ thì tôi nghĩ là giải quyết trên 95%

Ngoài ra cần cải tiến thuật toán ở các chỗ sau:

- Số lần thực hiện (length lst_ten_coc) là 0.5 x (length lst_ten_coc)^2 x 2 lần

- Dùng nth để duyệt list :

Tham khảo Test 3 NthVsForeach bài #2620 http://www.cadviet.com/forum/topic/14210-hoi-ve-lisp-thuat-toan-y-tuong-coding/page-131

Nếu dùng binary search còn nhanh hơn nhiều

- Các lisp khác hiepttr dùng entmake, lisp này dùng command

Tháng 12 3, 2015

Bác xem cho em cái bình đồ này với, với lisp dong4 thì chắc do line ENTCOC không có dữ liệu xdata, còn lisp dong5 em đã thay đổi khoảng cách tìm line text tên cọc lên 50m nhưng vẫn báo lỗi

"Quet chon BD de lay ten coc !
Select objects: Specify opposite corner: 598 found

Select objects:
Chon MEPTLT, MEPTLP, tim tuyen !
Select objects: 1 found

Select objects: 1 found, 2 total

Select objects: 1 found, 3 total

Select objects: ; error: bad argument type: lselsetp nil"
Bình đồ này ạ: http://www.cadviet.com/upfiles/5/64560_1111.dwg

Tháng 12 3, 2015

Chạy bình đồ này thì thấy thêm 1 lỗi là hàm

(ssget "_F" (lst_point_fence tim) '((0 . "LINE") (8 . "ENTCOC")))

Nếu các điểm (lst_point_fence tim) trùng nhau sẽ không select được.

Đường tim có 2 vertex đầu trùng nhau (1 & 2) , nếu cắt 1 đoạn ngắn ở đầu tuyến thì Lisp dong5 chạy OK

Tháng 12 3, 2015

...

Ngoài ra cần cải tiến thuật toán ở các chỗ sau:

- Số lần thực hiện (length lst_ten_coc) là 0.5 x (length lst_ten_coc)^2 x 2 lần
...

Cảm ơn sự chỉ dẫn của bác !

Có chổ này (phần trích dẫn ở trên) mình vẫn chưa hiểu ý trong câu ? Phiền bác nói rõ hơn :D

Tháng 12 3, 2015

Chạy bình đồ này thì thấy thêm 1 lỗi là hàm

(ssget "_F" (lst_point_fence tim) '((0 . "LINE") (8 . "ENTCOC")))

Nếu các điểm (lst_point_fence tim) trùng nhau sẽ không select được.

Đường tim có 2 vertex đầu trùng nhau (1 & 2) , nếu cắt 1 đoạn ngắn ở đầu tuyến thì Lisp dong5 chạy OK

Đúng như bác nói,em chạy OK rồi :D Thank bác!

Tháng 12 3, 2015

Sorry hơi nhầm 1 chút

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

Số lần thực hiện while tỉ lệ với số lượng lst_coc

Vòng (while (< i (length lst_ten_coc))

thực hiện bình quân là 1/2*lst_ten_coc lần + 1 lần gán i để thoát nhanh

Vì lst_coc = lst_ten_coc

=> Số lần thực hiện là (1/2*lst_coc + 1)*lst_coc

hiepttr debug sẽ thấy

Chỉ cần 1 biến trung gian, hàm (length lst_ten_coc) chỉ tính 1 lần

Tháng 12 4, 2015

Update DONG5 >>> DONG6:

- Thay command bằng entmake

- Fix lỗi hàm lst_point_fence cho trường hợp có điểm trùng (như trên)

- Duyệt list bằng foreach ... thay cho while+nth ...

- Thêm cột K/c lẻ

....

p/s:

@ndtnv: Nếu mà thay WP bằng F hay CP thì xác suất chọn được tên cọc cao hơn nhưng phải xữ lý khá nhiều mà chưa chắc đã "toàn vẹn"

>>> Thôi thì bác cho mình bảo lưu vậy :D :D :D

(defun c:DONG6 ( / lst_va old ss_coc ss lst_name tim tlt tlp lst_ten_coc lst_coc mid_pnt ten ob trai phai mid_pt fn pw c last_piles)
;
(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))
							ten "No name")
					(foreach elem lst_ten_coc
						(if (find_piles (car elem) mid_pnt 50) (setq ten (last elem)))
					)	   ;for
					(list x mid_pnt ten)
				)
				lst_coc)
		)
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT,Ten coc,K/c le,Trai,,,Phai" pw)
		(write-line ",,,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
	;;xong tieu de
		(setq c (car lst_coc))
			(setq 	mid_pt (cadr c)
					last_piles mid_pt
					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)))))
			)
			(Ket_insert "cocmoc" trai 1 0)
			(Ket_insert "cocmoc" phai 1 0)
			(make_dim_al mid_pt trai)
			(make_dim_al mid_pt phai)
			(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)
	;xong dong 1	
		(foreach c (cdr 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)))))
			)
			(Ket_insert "cocmoc" trai 1 0)
			(Ket_insert "cocmoc" phai 1 0)
			(make_dim_al mid_pt trai)
			(make_dim_al mid_pt phai)
			(write-line (strcat "," (last c)"," (rtos (distance mid_pt last_piles) 2 3) "," (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)
			(setq last_piles mid_pt)
		)
		(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 pre fence1)
(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))
		)
	)
)
(setq	pre (car fence)
		fence1 (list pre))
(foreach p (cdr fence)
	(cond ((not (equal 0 (distance p pre) 1e-3)) 
			(setq	fence1 (cons p fence1)
					pre p))
	)
)
fence1
)
;;;===============================================================
(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)
)
;;;===========================================================
(defun make_dim_al(pnt1 pnt2 / )
(setq lst
(list
	'(0 . "DIMENSION")
	'(100 . "AcDbEntity") 
	'(8 . "dim") 
	'(100 . "AcDbDimension") 
	(cons 10 pnt2) 
	(cons 11 (mid pnt1 pnt2))
	'(70 . 33) 
	'(1 . "") 
	'(100 . "AcDbAlignedDimension") 
	(cons 13 pnt1) 
	(cons 14 pnt2) 
))
(entmake lst)
)
;=============================================================
(defun Ket_insert (bname p s r)
;Insert simple static block
;Ten  point scale rotation
(entmake
	(list
		'(0 . "INSERT")      
		(cons 2 bname)
		(cons 10 p)
		(cons 41 s)(cons 42 s)(cons 43 s)      
		(cons 50 r)
	)	  ; list
)
)
;=======================

Tháng 12 4, 2015

Duyệt bằng foreach như vậy thì chậm hơn vì lấy phần tử lst_ten_coc nhanh hơn 1 ít nhưng phải gọi hàm find_piles cho toàn bộ list chậm hơn nhiều.

hiepttr thử suy nghĩ cách giải quyết khác xem

Tháng 12 4, 2015

Nghe bác xúi bậy làm thử thế này thì tiết kiệm được 547millisecs so với DONG6 ở trên :D :D :D

p/s:

Bác cho hỏi khhông biết mình suy lụn thế này có đúng ko ? :D :D :D

- Để vòng lặp có thể "thoát ngang" khi tìm thấy tên cọc >>> Chỉ có thể là while

- Không nên dùng nth thì trung thành với car, setq, cdr vậy (mấy thằng này chắc ko dính chấu tốc độ chứ bác nhỉ ^^ )

:D :D :D

(defun c:DONG7 ( / lst_va old ss_coc ss lst_name tim tlt tlp lst_ten_coc lst_ten_coc2 lst_coc mid_pnt ten ob trai phai mid_pt fn pw c last_piles)
;
(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 t1 (getvar 'millisecs))
		;;==================
		(setq lst_coc 
			(mapcar 
				'(lambda (x) 
					(setq	mid_pnt (mid (vlax-curve-getStartpoint x) (vlax-curve-getEndpoint x))
							lst_ten_coc2 lst_ten_coc)
					(while (and lst_ten_coc2 (not (setq find (find_piles (car (setq ten (car lst_ten_coc2))) mid_pnt 50))))
						(setq lst_ten_coc2 (cdr lst_ten_coc2))
					)	  ;while
					(if find (list x mid_pnt (last ten)) (list x mid_pnt "No name"))
				)
				lst_coc)
		)
		;;====================
		(setq t2 (getvar 'millisecs))
		(princ (strcat "\nDoan find_piles chay het " (rtos (- t2 t1)) "millisecs"))
		;;-----------------------
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT,Ten coc,K/c le,Trai,,,Phai" pw)
		(write-line ",,,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
	;;xong tieu de
		(setq c (car lst_coc))
			(setq 	mid_pt (cadr c)
					last_piles mid_pt
					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)))))
			)
			(Ket_insert "cocmoc" trai 1 0)
			(Ket_insert "cocmoc" phai 1 0)
			(make_dim_al mid_pt trai)
			(make_dim_al mid_pt phai)
			(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)
	;xong dong 1	
		(foreach c (cdr 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)))))
			)
			(Ket_insert "cocmoc" trai 1 0)
			(Ket_insert "cocmoc" phai 1 0)
			(make_dim_al mid_pt trai)
			(make_dim_al mid_pt phai)
			(write-line (strcat "," (last c)"," (rtos (distance mid_pt last_piles) 2 3) "," (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)
			(setq last_piles mid_pt)
		)
		(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 pre fence1)
(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))
		)
	)
)
(setq	pre (car fence)
		fence1 (list pre))
(foreach p (cdr fence)
	(cond ((not (equal 0 (distance p pre) 1e-3)) 
			(setq	fence1 (cons p fence1)
					pre p))
	)
)
fence1
)
;;;===============================================================
(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)
)
;;;===========================================================
(defun make_dim_al(pnt1 pnt2 / )
(setq lst
(list
	'(0 . "DIMENSION")
	'(100 . "AcDbEntity") 
	'(8 . "dim") 
	'(100 . "AcDbDimension") 
	(cons 10 pnt2) 
	(cons 11 (mid pnt1 pnt2))
	'(70 . 33) 
	'(1 . "") 
	'(100 . "AcDbAlignedDimension") 
	(cons 13 pnt1) 
	(cons 14 pnt2) 
))
(entmake lst)
)
;=============================================================
(defun Ket_insert (bname p s r)
;Insert simple static block
;Ten  point scale rotation
(entmake
	(list
		'(0 . "INSERT")      
		(cons 2 bname)
		(cons 10 p)
		(cons 41 s)(cons 42 s)(cons 43 s)      
		(cons 50 r)
	)	  ; list
)
)
;=======================

Tháng 12 4, 2015

Nghe bác xúi bậy làm thử thế này thì tiết kiệm được 547millisecs so với DONG6 ở trên :D :D :D

p/s:

Bác cho hỏi khhông biết mình suy lụn thế này có đúng ko ? :D :D :D

- Để vòng lặp có thể "thoát ngang" khi tìm thấy tên cọc >>> Chỉ có thể là while

- Không nên dùng nth thì trung thành với car, setq, cdr vậy (mấy thằng này chắc ko dính chấu tốc độ chứ bác nhỉ ^^ )

Chưa test cdr vs foreach

foreach không thể thoát ngang nhưng lấy phần tử nhanh hơn nth trên 200 lần (với list có khoảng 50000 phần tử)

nth có thể thoát ngang, trung bình duyệt 1/2 list nên có thể xem foreach nhanh hơn nth trên 100 lần

(setq ten nil)

(foreach elem lst_ten_coc

(if (not ten) ....

) ;for

Hoặc có thể đặt 1 biến phụ khác thì không cần hàm not

Ps: Tuy thời gian lấy phần tử không đáng kể so với làm việc khác nên tiết kiệm time không bao nhiêu, nhưng tối ưu thời gian trong lập trình là 1 thói quen tốt

Tháng 12 4, 2015

@ndtnv:

Ở #60 mình đã ... foreach ... rồi đó thôi :D

Mình muốn hứng được string nên (setq ..."No name") mà không (setq ... nil)

>>> Sau bài #61 bác vẫn nói là chậm nên mới làm tiếp ở #62 ==>> cải thiện được hơn 0.5 giây so với foreach

:D :D :D

Cảm ơn bác !

Do khả năng còn chưa được bao nhiêu nên cứ mãi chú ý vào chuyện làm được hay không, từ nay mình sẽ lưu ý vấn đề tốc độ nhiều hơn.

Tháng 12 6, 2015

Đoạn tuyến này em lại bị lỗi như #55, em down lisp dong6, dong7 mới của bác hiepttr nhưng vẫn bị lỗi, các bác xem hộ em với nhé.

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

Tháng 12 7, 2015

Trong khi chờ đợi hiepttr sửa lisp, bạn có thể làm 1 trong 2 cách sau:

1 - Trong file CAD, sửa layer "Tuyen" => "TUYEN"

2 - Trong file LISP, sửa "TUYEN" => "Tuyen" (2 chỗ)

Nếu học debug, tìm ra lỗi này không quá 5'

Tháng 12 8, 2015

Ok rồi thank bác nhiều nhé. Em muốn hỏi thêm bác vấn đề này nữa, nếu như em muốn cắm cọc gpmb từ mép taluy ngoài ra thêm 1 khoảng cách nhất định (đấy chính là phạm vi để sau này thi công) thì thêm hệ số nào trong lisp ạ?

Tháng 2 23, 2019

Vào lúc 16/10/2015 tại 11:11, phamthanhbinh đã nói:
Hề hề hề,

Bạn tham khảo lisp sau đây. Lưu ý hai vấn đề sau:

1/ Bạn phải tạo block "cocmoc1" có các thành phần giống như block cocmoc của bạn nhưng có điểm chèn là tâm của hình tròn bao. (mình đã tạo block này trong file bản vẽ gửi kèm ở bài này)

2/- hãy xóa các pline mép taluy trùng nhau (khá nhiều đấy) để tránh chèn trùng lắp quá nhiều block. (Trong file bản vẽ kèm theo ở đây mình đã xáo hết chỉ để lại mỗii bên một đường thôi.)

Hãy test thử và cho ý kiến nếu cần chỉnh sửa nhé.

http://www.cadviet.com/upfiles/5/5194_camcocgpmb_1.lsp

http://www.cadviet.com/upfiles/5/5194_64560_gpmbbd_1.dwg
ccmb.lsp

[✎]
(defun c:ccmb (/ oldos ls1 ls2 plst )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(alert "Chon cac coc tim duong")
(setq ls1 (acet-ss-to-list (ssget (list (cons 0 "line") (cons 8 "entcoc")))) )
(alert "Chon cac duong mep taluy ")
(setq ls2 (acet-ss-to-list (ssget (list (cons 0 "*line") (cons 8 "dientichtn")))) 
          plst (list) )
(foreach e1 ls1
         (foreach e2 ls2
                (setq plst (append plst (acet-geom-intersectwith e1 e2 1)))
         )
)
(command "undo" "be")
(foreach p plst
         (command "insert" "cocmoc1" p 1 1 0)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

Bác PHAMTHANHBINH có thể viết thêm giúp em vào lisp cắm cọc GPMB này phép đo khoảng cách từ cọc tới tim đường và xuất kết quả ra file txt không ạ. em xin cảm ơn nhiều

Tháng 4 12, 2021

Có bác nào có lisp rải đối tượng/block theo các điểm gãy của pline ko ạ? Em nhớ có đọc rồi mà giờ tìm không thấy. Mục đích là phục vụ cắm cọc GPMB ạ

Đăng nhập

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

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

hiepttr 538

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

dangky2510 6

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

hiepttr 538

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

ndtnv 481

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

dangky2510 6

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

ndtnv 481

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

hiepttr 538

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

dangky2510 6

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

ndtnv 481

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

hiepttr 538

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

ndtnv 481

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

hiepttr 538

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

ndtnv 481

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

hiepttr 538

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

dangky2510 6

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

ndtnv 481

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

dangky2510 6

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

twins87bmt 4

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

mascehuy 6

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

Tạo một tài khoản hoặc đăng nhập để nhận xét