Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
66 replies to this topic

#61 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 04 December 2015 - 01:40 PM

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


  • 0

#62 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 04 December 2015 - 03:56 PM

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

  • 0

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

Bergson


#63 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 04 December 2015 - 04:17 PM

 

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


  • 1

#64 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 04 December 2015 - 04:51 PM

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


  • 0

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

Bergson


#65 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 06 December 2015 - 10:28 AM

Đ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.c...64560_test1.dwg


  • 0

#66 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 07 December 2015 - 09:04 AM

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'


  • 1

#67 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 08 December 2015 - 08:47 PM

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 ạ?

64560_hinh1.jpg


  • 0