Chuyển đến nội dung
Diễn đàn CADViet
ketxu

[Hỏi]Đố vui với LISP

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

@bác TrungNgaMy : Thật lạ là bác dùng hàm taodanhsach để chọn tập chọn Line -> xuất ra file dữ liệu -> dùng đoạn lisp khác để đọc dữ iệu từ file xuất ra, tính toán và trả về kết quả, trong khi ngay từ bước duyệt qua đối tượng đã có thể tính toán luôn được rồi ^^.Có thể bác còn dùng file dữ liệu đó để làm việc khác, bằng chương trình khác, ngôn ngữ khác ^^.... Thôi không xét đến vấn đề tại sao có list, ta cứ làm 1 hàm kiểm tra khoảng cách điểm đến đường thẳng (khoảng cách theo định nghĩa của bác), với 3 đối số là (p1 p2 p3) (p1 p2 là 2 đầu, p3 là point kiểm tra). Còn bước so sánh nó với các khoảng cách khác thì vẫn vậy thôi ^^.

Đêm về e thử viết 2 hàm (1 : tạo đối tượng, 2 : không tạo đối tượng) để bác Test và so sánh tốc độ xem sao

Do cái danh sách đó kg phải dùng 1 lần rồi bỏ, nên tạo danh sách trước và dùng dài dài trong quá trình chạy cad. Mỗi lần tạo lại danh sách rất lâu

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

2 hàm của bác đây : (p1 ,p2, p3 là các tọa độ WCS)

Hàm 1 (tham khảo) : Dựng đối tượng trước rồi lấy khoảng cách :

;Lay khoang cach ngan nhat tu 1 diem den bao doan thang
(defun pd1 (p1 p2 pt / dis ent)
;@Ketxu
(setq dis (distance pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object
         	(setq ent (entmakex (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)(cons 60 1))))) pt)))
(entdel ent)
dis
)

 

- Hàm 2 : sử dụng trans, không dựng đối tượng :

(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
 nm (mapcar '- p1 p2)
 p1_ (trans p1 0 nm)
 p2_ (trans p2 0 nm)
 pt_ (trans pt 0 nm)
 p1_x(abs (caddr p1_))
 p2_x (abs(caddr p2_))
 pt_x (abs(caddr pt_))
 min_x (min p1_x p2_x)
 max_x (max p1_x p2_x)
 dis (cond   ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
  )
)
dis
)

Thông thường hàm 2 sẽ nhanh hơn hàm 1 khoảng 10 lần ^^

  • Vote tăng 2

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

2 hàm của bác đây : (p1 ,p2, p3 là các tọa độ WCS)

.............

- Hàm 2 : sử dụng trans, không dựng đối tượng :

(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
 nm (mapcar '- p1 p2)
 p1_ (trans p1 0 nm)
 p2_ (trans p2 0 nm)
 pt_ (trans pt 0 nm)
 p1_x(abs (caddr p1_))
 p2_x (abs(caddr p2_))
 pt_x (abs(caddr pt_))
 min_x (min p1_x p2_x)
 max_x (max p1_x p2_x)
 dis (cond   ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
  )
)
dis
)

Thông thường hàm 2 sẽ nhanh hơn hàm 1 khoảng 10 lần ^^

Thanks Ketxu đã giới thiệu 1 ph/pháp mới (sử dụng trans) để tính toán.

 

Nhưng "hình như" sử dụng các tính toán cơ bản vẫn nhanh hơn sử dụng hàm của CAD (LISP) ??

Các bạn thử test hàm duới xem nhé. Thông thường sẽ nhanh hơn hàm trans khoảng 2 lần ^^

Thuật toán :

- Tính diện tích tam giác

- Tính đường cao

- k/tra chân đuờng cao nằm trong hay ngoài cạnh đáy

-> kết quả

(defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
   	(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
 	(setq res (list dis1 sta))
 	(setq res (list dis2 end)) ) )
 res)

  • Vote tăng 2

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

Chính xác là em thích tính toán như cách bác gia_bach giới thiệu hơn (#44), và phải thú nhận là hiện giờ em đã quên hết các công thức hình học rồi :D, nên dù có nhắc tới cũng đành lờ đi :D

Diện tích tam giác chỉ nhớ mỗi chiều cao*đáy / 2 (hơi xấu hổ tí ^^)

Cảm ơn bác gia_bach 1 lần nữa ^^

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

Cám ơn Ketxu và Giabach.

Vì đây là mục đố vui, mình nghĩ các bạn nên viết luôn phần còn lại để có thể chạy thử xem tốc độ thế nào. Vì phần còn lại còn phải so sánh kết quả kiểm tra với tất cả các đoạn thẳng và đưa ra danh sách vị trí các đoạn thẳng đc chọn. Căn cứ vào vị trí đó và đổi màu line đc chọn để xem kết quả có đúng line gần nhất kg.

Phần còn lại mình viết cũng đc nhưng đây đang KT tốc độ nên các bạn viết luôn đi. Tuy hơi chậm nhưng mình cũng sẽ viết một cái trên lisp để thử

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

..............

Nhưng "hình như" sử dụng các tính toán cơ bản vẫn nhanh hơn sử dụng hàm của CAD (LISP) ??

Các bạn thử test hàm duới xem nhé. Thông thường sẽ nhanh hơn hàm trans khoảng 2 lần ^^

.........

Xin đính chính một chút.

Sau khi k/tra kết quả chỉ nhanh hơn khoảng 1.5 lần.

 

Nhưng việc sử dụng cho k/quả không ổn định ?!

 

Command: TEST pick p1 :

pick p2 :

pick pt :

pd2 : 110

GetDis : 140

pd2 : 235

GetDis : 156

pd2 : 234

GetDis : 157

pd2 : 234

GetDis : 156

pd2 : 235

GetDis : 140

 

;..................

pd2 : 328

GetDis : 188

pd2 : 359

GetDis : 172

pd2 : 360

GetDis : 187

pd2 : 375

GetDis : 172

pd2 : 359

GetDis : 188

 

;..................

pd2 : 110

GetDis : 140

pd2 : 235

GetDis : 140

pd2 : 235

GetDis : 140

pd2 : 219

GetDis : 141

pd2 : 250

GetDis : 140

 

(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
 (setq nm (mapcar '- p1 p2)
p1_ (trans p1 0 nm)
p2_ (trans p2 0 nm)
pt_ (trans pt 0 nm)
p1_x (abs (caddr p1_))
p2_x (abs(caddr p2_))
pt_x (abs(caddr pt_))
min_x (min p1_x p2_x)
max_x (max p1_x p2_x)
dis (cond
  	((< pt_x min_x)(distance p1_ pt_))
  	((> pt_x max_x)(distance p2_ pt_))
  	(T (abs (-(car p1_)(car pt_))))   ))
 dis)[/i]
[i](defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
   	(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
 	(setq res (list dis1 sta))
 	(setq res (list dis2 end)) ) )
 res)[/i]
[i](defun c:test(/ count p1 p2 pt start)
 (setq p1 (getpoint "pick p1 : ")
p2 (getpoint p1 "\npick p2 : ")
pt (getpoint p2 "\npick pt : ")
Count 10000)
 (setq Start (getvar "Millisecs"))
 (repeat Count
(pd2 p1 p2 pt) )
 (princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))

 (setq Start (getvar "Millisecs"))
 (repeat Count
(GetDis p1 p2 pt) )
 (princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i]
[i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(pd2 p1 p2 pt) )
 (princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i][i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(GetDis p1 p2 pt) )
 (princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i]
[i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(pd2 p1 p2 pt) )
 (princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))

 (setq Start (getvar "Millisecs"))
 (repeat Count
(GetDis p1 p2 pt) )
 (princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i][i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(pd2 p1 p2 pt) )
 (princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i]
[i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(GetDis p1 p2 pt) )
 (princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i][i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(pd2 p1 p2 pt) )
 (princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i]
[i]  (setq Start (getvar "Millisecs"))
 (repeat Count
(GetDis p1 p2 pt) )
 (princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))

 (textscr)(princ ))

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

Nhanh hơn là tuyệt rồi bác ơi ^^

@bác TrungNgaMy : thực chất bác đang muốn làm việc gì đây ạ ? Theo yêu cầu của bác thì chưa có Line đâu ^^

Theo em thì có thể làm nhanh thế này :

List dữ liệu ban đầu :

lstPnt : (setq lstPnt (list (list p1 p2)(list p3 p4)(list p5 p6).....))

pt : point check

Hàm check của bác gia_bach e sửa dạng kết quả trả về (để ôm luôn dữ liệu đoạn thẳng theo ^^, như thế này hàm chậm đi tẹo nữa)

(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
  (setq res (list dis1 (list sta end)))
  (setq res (list dis2 (list sta end))))
)
 res)

 

Cuối cùng là vẽ Line gần Point nhất từ dữ liệu :

(defun test (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(pd3 (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 100)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))

Việc nhanh hay chậm còn phụ thuộc vào kiểu xuất dữ liệu, kiểu kết quả muốn trả về, do vậy câu đố của bác Trung đúng là trăm cửa đi :)

Bác test kết quả nhé

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

Mình viết hàm để chạy hai cái hàm của Ketxu và Giabach cung cấp :

(defun dxf( name n)
 (cdr (assoc n (entget name)))
)
(defun taodanhsach( / i p1 p2 lst)
 (setq ssss (ssget "x" '((0 . "line"))))
 (if ssss (progn
(setq i 0 l (sslength ssss))
(while (< i l)
 	(setq name (ssname ssss i))
 	(setq p1 (dxf name 10) p2 (dxf name 11))
 	(setq lst (append lst (list (list p1 p2))))
 	(setq i (1+ i))
)
 ))
 lst
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=53705&pid=168615&st=40entry168615
(defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
  (setq res (list dis1 sta))
  (setq res (list dis2 end)) ) )
 res)
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=53705&pid=168615&st=40entry168615
(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
 nm (mapcar '- p1 p2)
 p1_ (trans p1 0 nm)
 p2_ (trans p2 0 nm)
 pt_ (trans pt 0 nm)
 p1_x(abs (caddr p1_))
 p2_x (abs(caddr p2_))
 pt_x (abs(caddr pt_))
 min_x (min p1_x p2_x)
 max_x (max p1_x p2_x)
 dis (cond   ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
  )
)
dis
)
(defun timdtgd_gb( p lst / len lst1 i l len len0 p1 p2 dt)
 (setq i 0 len0 1000000.0 l (length lst))
 (while (< i l)
(setq dt (nth i lst) p1 (car dt) p2 (cadr dt))
(setq len (GetDis p1 p2 p))
(cond
 	((< len len0)
  	(setq len0 len lst1 (list i))
 	)
 	((= len len0)
  	(setq lst1 (append lst1 (list i)))
 	)
)
(setq i (1+ i))
 )
 lst1
)
(defun timdtgd_kx2( p lst / len lst1 i l len len0 p1 p2 dt)
 (setq i 0 len0 1000000.0 l (length lst))
 (while (< i l)
(setq dt (nth i lst) p1 (car dt) p2 (cadr dt))
(setq len (pd2 p1 p2 p))
(cond
 	((< len len0)
  	(setq len0 len lst1 (list i))
 	)
 	((= len len0)
  	(setq lst1 (append lst1 (list i)))
 	)
)
(setq i (1+ i))
 )
 lst1
)
(defun timdt_kx2( p / i lst1)
 (setq lst1 (timdtgd_kx2 p lst))
 lst1
)
(defun timdt_gb( p / i lst1)
 (setq lst1 (timdtgd_gb p lst))
 lst1
)
(defun c:timdtkx2(/ i lst1)
 (if (null lst) (setq lst (taodanhsach)))
 (setq p (getpoint "\Pick"))
 (setq lst1 (timdt_kx2 p))
 (foreach a lst1 (command "_.change" (ssname ssss a) "" "P" "c" 1 ""))
)
(defun c:timdtgb(/ i lst1)
 (if (null lst) (setq lst (taodanhsach)))
 (setq p (getpoint "\Pick"))
 (setq lst1 (timdt_gb p))
 (foreach a lst1 (command "_.change" (ssname ssss a) "" "P" "c" 1 ""))
)

, hàm của Ketxu thì chạy đc, nhưng hàm của Giabach thì báo lỗi,

 

Command: timdtgb

Pick; error: bad argument type for compare: (3564.59 (592058.0 1.18285e+006

0.0)) 1.0e+006

 

phiền bạn xem lại giúp. Thêm nữa, hàm test của bạn mình chưa hiểu.

 

@Ketxu : mình vừa đưa code lên thì thấy bài của bạn, cám ơn để mình xem.

Mình đưa ra bài toàn kg có đối tượng, nhưng muốn KT nó cũng cần có đối tg để tạo danh sách, trong giải thuật bạn chỉ dựa vào dữ liệu tọa độ và những hàm toán học để thao tác, sau khi trả về mình dựa vào đó xem kết quả có đúng kg và thời gian thế nào

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

Nhanh hơn là tuyệt rồi bác ơi ^^

@bác TrungNgaMy : thực chất bác đang muốn làm việc gì đây ạ ? Theo yêu cầu của bác thì chưa có Line đâu ^^

Theo em thì có thể làm nhanh thế này :

List dữ liệu ban đầu :

lstPnt : (setq lstPnt (list (list p1 p2)(list p3 p4)(list p5 p6).....))

pt : point check

Hàm check của bác gia_bach e sửa dạng kết quả trả về (để ôm luôn dữ liệu đoạn thẳng theo ^^, như thế này hàm chậm đi tẹo nữa)

(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
  (setq res (list dis1 (list sta end)))
  (setq res (list dis2 (list sta end))))
)
 res)

 

Cuối cùng là vẽ Line gần Point nhất từ dữ liệu :

(defun test (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(pd3 (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 100)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))

Việc nhanh hay chậm còn phụ thuộc vào kiểu xuất dữ liệu, kiểu kết quả muốn trả về, do vậy câu đố của bác Trung đúng là trăm cửa đi :)

Bác test kết quả nhé

bác thiếu cái hàm pd3 nên chưa test đc

 

P/S Sau khi test, hàm của Ketxu có TH trả vể đoạn thẳng kg đúng (mình sẽ cụ thể hóa TH kg đúng và đưa lên để bạn xem) và hàm của Gia_bach có lẽ kq trả về hơi khác yêu cầu một chút nên chưa test đc. Mình nói lại cho rõ để có sự thống nhất .

- 1/ Từ các đối tượng line trong bản vẽ , sd câu lệnh (setq ssss (ssget "x" '((0 . "line"))))

biến ssss là toàn cục các bạn đừng xóa đi.

- 2/ Từ ssss tạo danh sách đại khái là lst = (list dt0 dt1 dt2 .... dti ..... dtn) với 0, 1, 2 .... i .....n là vị trí của đoạn thẳng trong ssss

và dti là danh sách tọa độ của một đọan thẳng (list p1 p2) (phần dữ liệu này các bạn có thể tự sáng tạo)

- 3/ Sau khi cung cấp một điểm, kq trả vể là vị trí của đoạn thẳng (hoặc một số đoạn thẳng gần điểm) trong lst (hoặc ... do các bạn đạo diễn)

và quan trọng nó cũng là vị trí đối tượng line trong ssss.

- 4/ Căn cứ vị trí line trong ssss, có thể tô đỏ line đc chọn để Kt kết quả

(Hàm của mình viết dựa vào các hàm của Ketxu và Gia_bach cung cấp theo dạng như vậy)

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

@bác TrungNM : bác chú ý những dòng này trong hàm của bác gia_bach :<pre class="cadvietlispcode">

(setq res (list chcao pt0))(if (< dis1 dis2) (setq res (list dis1 sta)) (setq res (list dis2 end)) ) ) res)
Có nghĩa là kết quả trả về của bác gia_bach bao gồm list khoảng cách + 1 tọa độ điểm nốiĐể chỉ lấy về khoảng cách bác hãy chủ động sửa code hàm Getdis thành
(setq res chcao)(if (< dis1 dis2) (setq res dis1) (setq res dis2))) res)
hoặc lấy cadr của kết quả thu về.</pre>
  • Vote tăng 2

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

@Ketxu, Gia_bach:

Sau khi Ketxu hd, mình đã sửa tạm và đã test hàm do Gia_bach cung cấp. Hiện tại hàm do Gia_bach cung cấp chạy nhanh và chính xác hơn của Ketxu. Tuy nhiên, do 2 bạn chưa viết phần tiếp theo hoặc viết chưa hoàn thiện nên mình chỉ viết tạm theo kiểu tuần tự nên tốc độ kg nhanh.

 

Trên bv khá lớn khoảng 41391 line mà mình đã up lần đầu. tốc độ khá chậm có thể khó chấp nhận đc :

 

- theo hàm của Gia_bach

Command: (bench '(timdt_gb) (list p) 1)

TIMDT_GB

Tổng : ................8078 mili giây

Trung bình : 8078.0000 mili giây / 1 lần

 

- theo hàm của Ketxu

Command: (bench '(timdt_kx2) (list p) 1)

TIMDT_KX2

Tổng : ................8140 mili giây

Trung bình : 8140.0000 mili giây / 1 lần

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

@TrungNgaMy : em thấy đang lạc đề bác ạ

Quý bác nên nói thẳng, bác đừng giận em. Bác đang quá bị động.

- Phần bài bên trên bác nói thiếu hàm pd3 là vì e trót sửa trong máy hàm Getdis của bác gia_bach là pd3 để viết cho ngắn,nhưng cũng là cùng trong 1 bài, điều này quá khó nhận thấy hay sao ạ ???

- Hàm timdtkx2 hay timdt_gb có phần quan trọng nhất là TÌM KHOẢNG CÁCH NHỎ NHẤT do bác viết , sao lại nói là em / bác gia_bach cung cấp ? Em và bác gia_bach mới chỉ tham gia giải đố phần cách tìm khoảng cách từ Point đến đoạn thẳng thôi

- Hàm Getdis của bác gia_bach đã trả về kết quả, chỉ khác cách lấy kết quả về, liệu có quá khó để 1 programmer như bác nhìn thấy điều đó / thay đổi vừa ý mình ?

Bác chú ý mình đang đố vui 1 vấn đề, chứ không phải bài tập về nhà dành cho mọi người và phải hoàn thành để nộp ^^

Mình nói lại cho rõ để có sự thống nhất .

.....

biến ssss là toàn cục các bạn đừng xóa đi.

.......(phần dữ liệu này các bạn có thể tự sáng tạo)

....... do các bạn đạo diễn)

 

(Hàm của mình viết dựa vào các hàm của Ketxu và Gia_bach cung cấp theo dạng như vậy)

 

 

(defun c:test ()
;Local Function :
(defun dxf( name n)
 (cdr (assoc n (entget name)))
)
(defun taodanhsach (ss / i p1 p2 lst)
(setq i 0 l (sslength ss))
(while (< i l)
  (setq name (ssname ss i))
  (setq p1 (dxf name 10) p2 (dxf name 11))
  (setq lst (append lst (list (list p1 p2))))
  (setq i (1+ i))
)
 lst
)
(defun getmin (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(Getdis (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 1)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))
(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao (list sta end)))
(if (< dis1 dis2)
  (setq res (list dis1 (list sta end)))
  (setq res (list dis2 (list sta end))))
)
 res)

;============== Start Here
(setq ss (ssget '((0 . "line")))
pt (getpoint "\nDiem check :")
lst (taodanhsach ss)
start (car(_VL-TIMES))
enameLineGanNhat (getmin pt lst)
)
(princ (strcat "\n "
(rtos (/ (- (car (_VL-TIMES)) start) 1000.) 2 4)
" secs."
) ;_ strcat
))

Bác chú ý là hàm getmin em viết ra ở đây là cách đơn giản, nhanh và thường dùng nhất, nên không nói về vấn đề tốc độ. Nếu bác viết hàm so sánh nào khác thì cứ dùng, miễn là trả ra kết quả.

Giải thuật là :

Sau khi có list khoảng cách (kèm theo tọa độ Line tương ứng, bác có thể đạo diễn thành số hiệu của Line ), thì sắp xếp nó theo chiều lớn dần của Khoảng cách này. Sau đó lấy thằng đầu tiên (car), tất nhiên, sẽ là thằng có khoảng cách bé nhất, và chỉ lấy 1. Nếu bác muốn lấy nhiều hơn (có khả năng nhiều Line cùng khoảng cách) thì tiếp tục lấy các thằng tiếp theo.

Đến đây coi như đã đủ từ a-> z chưa ạ :)

Update : Code getdis mà em mạn phép sửa của bác gia_bach bên trên em có nhầm lẫn một chút nên gặp lỗi khi khoảng cách là đường cao tam giác, e đã sửa lại. Vô cùng xin lỗi các bác ^^

  • Vote tăng 1

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

@TrungNgaMy : em thấy đang lạc đề bác ạ

Quý bác nên nói thẳng, bác đừng giận em. Bác đang quá bị động.

- Phần bài bên trên bác nói thiếu hàm pd3 là vì e trót sửa trong máy hàm Getdis của bác gia_bach là pd3 để viết cho ngắn,nhưng cũng là cùng trong 1 bài, điều này quá khó nhận thấy hay sao ạ ???

- Hàm timdtkx2 hay timdt_gb có phần quan trọng nhất là TÌM KHOẢNG CÁCH NHỎ NHẤT do bác viết , sao lại nói là em / bác gia_bach cung cấp ? Em và bác gia_bach mới chỉ tham gia giải đố phần cách tìm khoảng cách từ Point đến đoạn thẳng thôi

- Hàm Getdis của bác gia_bach đã trả về kết quả, chỉ khác cách lấy kết quả về, liệu có quá khó để 1 programmer như bác nhìn thấy điều đó / thay đổi vừa ý mình ?

Bác chú ý mình đang đố vui 1 vấn đề, chứ không phải bài tập về nhà dành cho mọi người và phải hoàn thành để nộp ^^

 

 

 

(defun c:test ()
;Local Function :
(defun dxf( name n)
 (cdr (assoc n (entget name)))
)
(defun taodanhsach (ss / i p1 p2 lst)
(setq i 0 l (sslength ss))
(while (< i l)
  (setq name (ssname ss i))
  (setq p1 (dxf name 10) p2 (dxf name 11))
  (setq lst (append lst (list (list p1 p2))))
  (setq i (1+ i))
)
 lst
)
(defun getmin (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(Getdis (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 1)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))
(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
 ;; @Gia_Bach
 (defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
 (setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
 (if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001))   )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
 (if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
  (setq res (list dis1 (list sta end)))
  (setq res (list dis2 (list sta end))))
)
 res)

;============== Start Here
(setq ss (ssget '((0 . "line")))
pt (getpoint "\nDiem check :")
lst (taodanhsach ss)
enameLineGanNhat (getmin pt lst)
))

Bác chú ý là hàm getmin em viết ra ở đây là cách đơn giản, nhanh và thường dùng nhất, nên không nói về vấn đề tốc độ. Nếu bác viết hàm so sánh nào khác thì cứ dùng, miễn là trả ra kết quả.

Giải thuật là :

Sau khi có list khoảng cách (kèm theo tọa độ Line tương ứng, bác có thể đạo diễn thành số hiệu của Line ), thì sắp xếp nó theo chiều lớn dần của Khoảng cách này. Sau đó lấy thằng đầu tiên (car), tất nhiên, sẽ là thằng có khoảng cách bé nhất, và chỉ lấy 1. Nếu bác muốn lấy nhiều hơn (có khả năng nhiều Line cùng khoảng cách) thì tiếp tục lấy các thằng tiếp theo.

Đến đây coi như đã đủ từ a-> z chưa ạ :)

Cám ơn bạn đã có những phản hồi. Quả thật đôi lúc mình kg thể hiểu ý nhau nhanh vì sự chủ quan của người khác. Như vđ mình đưa lên theo mình là rất rõ ràng mà các bạn cũng qua vài lần mới nắm hết ý đc. Quả thật tình mình kg hiểu hàm pd3 là cái bạn đặt sau khi chỉnh code của Gia_bach, khi mình thực thi nó báo lỗi.

Còn về hai cái hàm mình viết mình nói rõ là viết tạm dựa trên hai hàm do bạn và Gia_bach cung cấp và mình chỉ viết tuần tự thôi nên nó chậm, mình muốn các bạn viết ra vì mình nghĩ các bạn sẽ có giải pháp tố hơn. Nhìn code ban viết mình thấy ngắn gọn nhưng lúc đó thiếu cái pd3 nên kg thử đc

Phần code của Gia_bach có thể mình cũng hiểu nhưng nếu mình sửa đổi ở dòng cuối thì có thể kg tối ưu bằng chính Gia_bach sửa.

Mình kg phải là 1 programmer , mình quá mức nghiệp dư, chỉ thích lập trình thôi. Mình rất thích cách viết code súc tích ngắn gọn của bạn

Một lần nữa cám ơn bạn và Gia_bach

 

P/S bây giờ mình bận việc phải đi, sẽ quay lại sau

  • Vote tăng 1

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

Thực ra là Ketxu "lừa" thiên hạ thôi. Chứ có rất nhiều cách gọi dialoge bằng chỉ 1 dòng (tức 1 hàm) như Ketxu. Lý do là các hàm này đã lập sẵn trong 1 số file của cad (VD: acad200x.lsp ...). Đáp án của bác Tue_NV là chuẩn. Câu đố này "sao sao ấy", nhưng xét về mặt "đố cho vui" thì cũng vui.

Thân thương!

P/S: nói thêm để đỡ tốn đất: tôi không hề trách Ket đâu, chỉ là vui thôi mà, hơn nữa cũng thêm 1 thông tin để mọi người biết: có 1 số hàm được lập sẵn trong cad để gọi dialoge chỉ bằng 1 dòng (tức 1 hàm). Dù biết vậy nhưng chính tôi cũng bị Ket lừa đấy. Hì, hì, hì!!!

Hề hề hề,

Đây là đố vui mà.

Đã là đố, ắt phải có tí xảo thuật trong đó để nhiều người không biết. Không thể gọi đó là lừa được, vì chắc chắn sẽ có giải đố mà. Chẳng qua chỉ là để kẻ chưa biết thì mót thêm được tí, người biết rồi thì cũng có dịp ôn lại cái mình ít dùng.

Vậy nên nó rất vui vì giúp ích được nhiều người.

Thú thực là mình cũng toàn đi mót từ những cái mọi người vui mà post lên thế này cả đấy.

Hy vọng rằng (nếu coi đây là lừa) mọi người hãy chịu khó để lừa mình thêm càng nhiều càng ít hỉ.

Hề hề hề ,....

PS: mà chửa biết ai lừa ai đâu nhé?????

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

........................

Phần code của Gia_bach có thể mình cũng hiểu nhưng nếu mình sửa đổi ở dòng cuối thì có thể kg tối ưu bằng chính Gia_bach sửa.

Mình kg phải là 1 programmer , mình quá mức nghiệp dư, chỉ thích lập trình thôi. Mình rất thích cách viết code súc tích ngắn gọn của bạn

.............

Tôi cũng kô phải là 1 programmer, viết giải trí cho vui ...

V/đề "tối ưu" : tôi nghĩ rằng viết nhiều, đọc nhiều, mót nhiều ... và sau khi so sánh nhiều ph/án tự mình sẽ rút ra đuợc ph/án "tối ưu" nhất. Khi đó code (ý tưởng) của người khác tự nó "sẽ là của mình".

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

@bác TrungNgaMy : vì e chậm hiểu, lại nói xong mới nghĩ, có gì nóng nảy bác thông cảm. Dù sao thì ở đây có mấy ai là không nghiệp dư ^^ Bác còn viết ARX từ hồi em chưa biết máy tính cơ :|

Hàm getmin chắc chắn có nhiều đáp án nhanh hơn nữa để bác lựa chọn (theo em nhớ thì apply min nhanh hơn vl-sort thì phải ^^), mà phản xạ ì trệ quá, đành ngồi chờ thôi :D

P/S : số lượng list của bác mà lớn chắc cũng tầm 100k đối tượng thôi chứ ^^ Dù gì cũng cần đến thực tế sử dụng

 

@bác Bình : e vẫn đang chờ bác ĐVH ra thêm vài câu đố đây ^^ Đã gọi là đố vui thì phải có tí quái chứ bác hè ^^

 

Nhân tiện có 1 câu đố mới, mời các bác giải đố. Câu này quá nhiều người biết, nên giải là 2 phát thanks và thời hạn đến 10h tối thôi nhé ^^

Làm cách nào để chọn nhanh tất cả các đối tượng, trừ các đối tượng thuộc layer bị đóng băng trong bản vẽ ?

  • Vote tăng 1

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

Chà, chỉ một câu nói mà hôm kia Ket trách, sau đó tôi P/S thì Ket rút lại lời trách. Hôm nay tưởng qua rồi, ai ngờ bị bác PTB trách nữa, rồi lại bị Ket "chờ" khéo nữa. Biết vậy, sau khi Ket rút lại lời trách thì tôi cũng rút của mình luôn cho xong.

Tôi srr tất cả, và mong bỏ qua cho, chứ nếu không thì... không dám đố đâu.

Thân thương!

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

Giờ còn trách gì nữa. Lúc đọc comment của bác e định dislike nhưng chẳng có, nói thì cũng chẳng vui, nên thôi!

Câu đố đó e định để đi kèm với các hàm acad_colordlg,acad_helpdlg ... nhưng bị bắt bài nên ngậm hạt thị thôi. Dù sao thì bác ĐVH bây giờ cũng khác xưa rồi ^^ Ngoài ra còn các hàm nào undocument nữa k bác ?? ( e khoái nhất cheat hay EE kiểu thế)

Quanh đi quẩn lại có mấy người, khuấy lên 1 tí cho vui, mình e cm mãi, buồn. Bác đố câu gì dễ dễ th, để gọi là cùng nhau kiếm tí thanks :D

Các bác giải câu trên đi, để e còn đưa câu khác

  • Vote tăng 1

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

Chà, chỉ một câu nói mà hôm kia Ket trách, sau đó tôi P/S thì Ket rút lại lời trách. Hôm nay tưởng qua rồi, ai ngờ bị bác PTB trách nữa, rồi lại bị Ket "chờ" khéo nữa. Biết vậy, sau khi Ket rút lại lời trách thì tôi cũng rút của mình luôn cho xong.

Tôi srr tất cả, và mong bỏ qua cho, chứ nếu không thì... không dám đố đâu.

Thân thương!

Hề hề hề,

Ai bảo đấy là trách móc nhỉ???? Ấy chỉ là vài điều tâm sự của anh hề thôi mà. Mình vốn là dân đi mót nên cái cảnh bị cầm gậy đuổi xua, bị ném đá cũng đã nhiều. Cho nên mới sinh ra cái tâm sự hề hề hề như vầy. Những mong cho cái hề hề hề nó nhiều hơn trong cuộc đời mà thôi. Có vậy mới có thể yên tâm mà mót được các bác ạ.

Hề hề hề,....

Mà bác rút cái chi thì rút chứ chớ có rút ..... lui nghen. Mình và mọi người còn cần nhiều tới sự giúp sức của bác mà......

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

@bác TrungNgaMy : vì e chậm hiểu, lại nói xong mới nghĩ, có gì nóng nảy bác thông cảm. Dù sao thì ở đây có mấy ai là không nghiệp dư ^^ Bác còn viết ARX từ hồi em chưa biết máy tính cơ :|

Hàm getmin chắc chắn có nhiều đáp án nhanh hơn nữa để bác lựa chọn (theo em nhớ thì apply min nhanh hơn vl-sort thì phải ^^), mà phản xạ ì trệ quá, đành ngồi chờ thôi :D

P/S : số lượng list của bác mà lớn chắc cũng tầm 100k đối tượng thôi chứ ^^ Dù gì cũng cần đến thực tế sử dụng

 

@bác Bình : e vẫn đang chờ bác ĐVH ra thêm vài câu đố đây ^^ Đã gọi là đố vui thì phải có tí quái chứ bác hè ^^

 

Nhân tiện có 1 câu đố mới, mời các bác giải đố. Câu này quá nhiều người biết, nên giải là 2 phát thanks và thời hạn đến 10h tối thôi nhé ^^

Làm cách nào để chọn nhanh tất cả các đối tượng, trừ các đối tượng thuộc layer bị đóng băng trong bản vẽ ?

Hề hề hề,

Cố đấm một phát xem có ăn được xôi của bác ketxu không hỉ???

(setq lstr "")

(while (setq a (tblnext "layer"))

(if (and (/= (cdr (assoc 70 (tblsearch "layer" a))) 1) (/= (cdr (assoc 70 (tblsearch "layer" a))) 2))

(setq lstr (strcat lstr a ",")

)

)

(setq lstr (substr lstr 1 (1- (strlen lstr))))

(setq ss (ssget "x" (list (cons 0 lstr))))

Hề hề hề,

Nếu chẳng được xôi mong bác chớ trách phạt nghen.

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

Làm cách nào để chọn nhanh tất cả các đối tượng, trừ các đối tượng thuộc layer bị đóng băng trong bản vẽ ?

( command "_.select" "all" "")

(ssget "P")

  • Vote tăng 1

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

Làm cách nào để chọn nhanh tất cả các đối tượng, trừ các đối tượng thuộc layer bị đóng băng trong bản vẽ ?

(setq ss (ssget))

Chỉnh sửa theo master_worse

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

(setq lstr "")

(while (setq a (tblnext "layer"))

(if (and (/= (cdr (assoc 70 (tblsearch "layer" a))) 1) (/= (cdr (assoc 70 (tblsearch "layer" a))) 2))

(setq lstr (strcat lstr a ",")

)

)

(setq lstr (substr lstr 1 (1- (strlen lstr))))

(setq ss (ssget "x" (list (cons 0 lstr))))

Em không chạy được bác ạ ^^ Chắc chỗ setq lstr bị thiếu dấu đóng ngoặc ^^

 

(setq ss (ssget))

Câu đố là chọn nhanh toàn bộ đối tượng...mà bác ^^

 

( command "_.select" "all" "")

(ssget "P")

Bác TNM trả lời đúng, xin tặng bác 2 Thanks ^^

 

Đáp án của em :

(ssget "_A")
  • Vote tăng 3

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

Ket xu có vẻ như rất nôn nóng nhận tick Thanks nhỉ?

Cơ hội đây : Đây là lệnh gì?

Làm thế nào để CAD hiện được hộp thoại này một cách nhanh nhất

dim_3.jpg

 

Khi nhấn OK -> thì CAD cho mình chọn Dim -> Các dim được chọn sẽ gán dimension style trong hộp thoại mà ta đã chọn?

Lệnh gì vậy nhỉ?

Cơ cấu giải thưởng : 8 tick thanks dành cho đáp án đúng và cho sử dụng tài liệu. hề hề

Ai thấy câu đố này hay cũng có thể tick Thanks cho mình. Hì hì

  • Vote tăng 2

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×