Đế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

#41 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 23 November 2015 - 02:58 PM

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.c...binh_do_goc.dwg


  • 0

#42 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 24 November 2015 - 02:35 PM

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


  • 0

#43 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 25 November 2015 - 05:18 PM

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


  • 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


#44 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 26 November 2015 - 07:52 AM

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.c...nh_do_goc_1.dwg

Lisp gần nhất bác sửa cho em: http://www.cadviet.c...bang_toa_do.lsp

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


  • 0

#45 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 27 November 2015 - 04:39 PM

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


  • 1

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


#46 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 30 November 2015 - 08:10 AM

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


  • 0

#47 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 30 November 2015 - 11:18 AM

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


  • 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


#48 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 30 November 2015 - 03:32 PM

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.c.../64560_test.dwg

http://www.cadviet.c.../64560_test.zip


  • 0

#49 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 30 November 2015 - 04:58 PM

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

  • 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


#50 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 01 December 2015 - 02:49 PM

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

 

64560_abvc.jpg


  • 0

#51 hiepttr

hiepttr

    Edu level: li10

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

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

- 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

80156_untitled.jpg

 

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


  • 1

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


#52 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 02 December 2015 - 02:18 PM

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


  • 0

#53 hiepttr

hiepttr

    Edu level: li10

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

Đã gửi 02 December 2015 - 03:16 PM

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


  • 1

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


#54 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 03 December 2015 - 12:54 PM

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)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.c...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


  • 1

#55 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 03 December 2015 - 02:34 PM

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.c.../64560_1111.dwg


  • 0

#56 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 03 December 2015 - 03:37 PM

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


  • 1

#57 hiepttr

hiepttr

    Edu level: li10

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

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

...

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


  • 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


#58 dangky2510

dangky2510

    biết vẽ circle

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

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

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!


  • 0

#59 ndtnv

ndtnv

    biết lệnh minsert

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

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

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


  • 1

#60 hiepttr

hiepttr

    Edu level: li10

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

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

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

  • 1

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