Đến nội dung


Hình ảnh
- - - - -

Hỏi: Cách nội suy tâm đường tròn 3D


  • Please log in to reply
58 replies to this topic

#41 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 28 December 2010 - 11:31 AM

Hề hề hề,
Bác thiep chỉ được cái nói đúng. Vì bạn duyminh86 nói là dựng mặt phẳng sao cho tổng bình phương khoảng các từ các điểm tới mặt phẳng đó là nhỏ nhất chớ không phải là tổng bình phương khoảng cách tới vòng tròn đi qua ba điểm bác ạ (Đây là bài toán khác với bài trước)
Cái điều kiện ra>=0.9 vì ra là cos của góc tạo bởi mặt phẳng qua 3 điểm với mặt phẳng chuẩn (mà ở đây mình lấy là mắt z=0) nên khi ra>=0.9 góc nghiêng này sẽ nhỏ hơn 25 độ bác ạ. Mục đích là để loại bớt các mặt phẳng quá nghiêng như bạn DUYMINH86 nói mà thôi bác à.
Thực ra kc đúng là số dương nhưng tại vì trong công thức giải tích có cái căn nên mình sợ nó lấy cả giá trị âm thì bỏ bu nên chơi vầy cho chắc cú thối bác ạ.
Cám ơn bác về cái hàm (acet-list-remove-duplicates lst nil) , vì cái khoản về các hàm acet này mình chưa mót được nhiều bác ạ.
Chúc bác khỏe và vui nhân dịp năm mới...

Chào bác Bình, ý của Duyminh86 thì như thế này:

...
Thứ 2 xét trong không gian[/b], mình có vật hình trụ như trong hình vẽ:
Hình đã gửi
mình có một số điểm màu vàng nằm ko cùng trong mặt phẳng tiết diện cắt hình trụ theo phương vuông góc với trục hình trụ. Mình muốn tìm tâm của đường tròn nằm trong mặt phẳng vuông góc đó (hoặc nằm trong mặt phẳng tạo với mặt phẳng vuông góc đó 1 góc <1độ theo mọi hướng) sao cho mặt phẳng đó có tổng khoảng cách tới các điểm màu vàng là nhỏ nhất, và trên mặt phẳng đó tìm tâm đường tròn có tổng khoảng cách tới các điểm màu vàng là nhỏ nhất
(làm theo phương pháp bình phương tối thiểu thì tốt quá)

Theo Thiep thì duyminh muốn tìm tâm (hay tìm đường tròn) có 2 điều kiện:
- đường tròn nằm trong mặt phẳng, sao cho mặt phẳng đó có tổng khoảng cách (hay tổng bình phương các khoảng cách) tới các điểm màu vàng là nhỏ nhất,
- đường tròn có tổng khoảng cách (hay tổng bình phương các khoảng cách) tới các điểm màu vàng là nhỏ nhất.
Nói tóm lại theo Thiep, đường tròn đó có tổng khoảng cách (hay tổng bình phương các khoảng cách) từ các điểm màu vàng đến đường tròn là nhỏ nhất. Giống như có 1 đám mây bụi (điểm) nằm không trật tự trong 1 không gian hình xuyến (torus), bây giờ phải đi tìm đường tâm gần đúng của hình xuyến này.
Cầu chúc bác Bình tìm ra cái đường tâm hình xuyến nầy.
  • 0

#42 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 December 2010 - 12:02 PM

Chào bác Bình, ý của Duyminh86 thì như thế này:

Theo Thiep thì duyminh muốn tìm tâm (hay tìm đường tròn) có 2 điều kiện:
- đường tròn nằm trong mặt phẳng, sao cho mặt phẳng đó có tổng khoảng cách (hay tổng bình phương các khoảng cách) tới các điểm màu vàng là nhỏ nhất,
- đường tròn có tổng khoảng cách (hay tổng bình phương các khoảng cách) tới các điểm màu vàng là nhỏ nhất.
Nói tóm lại theo Thiep, đường tròn đó có tổng khoảng cách (hay tổng bình phương các khoảng cách) từ các điểm màu vàng đến đường tròn là nhỏ nhất. Giống như có 1 đám mây bụi (điểm) nằm không trật tự trong 1 không gian hình xuyến (torus), bây giờ phải đi tìm đường tâm gần đúng của hình xuyến này.
Cầu chúc bác Bình tìm ra cái đường tâm hình xuyến nầy.

Hề hề hề,
Bác Thiep ơi, mình cũng hiểu như vầy, song mình định làm là bước 1 xác định cái mặt phẳng đã, bước 2 chiếu các điểm đã cho vuông góc với mặt phẳng đã xác định (vậy nên mới tìm cái phương trình mặt phẳng để lưu lại). Và bước 3 thì áp dụng cái lisp tìm tâm vòng tròn trên mặt phẳng đó có tổng khoảng cách từ các điểm hình chiếu tới vòng tròn là nhỏ nhất bác ạ.
Tuy nó chưa thật đúng với cái bạn Duyminh yêu cầu nhưng mình nghĩ nó sẽ đơn giản hơn vì áp dụng được cái lisp trước đã làm (cho nó có hệ thống tư duy ấy mà) . Bởi vì tổng bình phương khoảng cách từ các điểm trong không gian tới vòng tròn tìm được có nhẽ cũng có thể hiểu gần đúng là tổng bình phương các khoảng cách từ các điểm tới mặt phẳng cộng tổng bình phương hình chiếu của đoạn thẳng nối trên mặt phẳng đó phải không bác. Mà mình đã chơi với hai thằng nhỏ nhất rùi thì chắc sẽ được cái bạn ấy yêu cầu.

Vì nghĩ vậy nên mình mới post cái phần xác định mặt phẳng đã xem ý ông chủ thớt ra sao, nhưng thấy im im nên chửa biết có nên làm tiếp hay không bác à.
Hề hề hề. Nếu Bác có giải thuật nào tốt hơn thì bày cho mình với. Mình mới nghĩ lôm côm được đến đó à, hề hề hề....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#43 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 28 December 2010 - 01:51 PM

Hề hề hề,
Bác Thiep ơi, mình cũng hiểu như vầy, song mình định làm là bước 1 xác định cái mặt phẳng đã, bước 2 chiếu các điểm đã cho vuông góc với mặt phẳng đã xác định (vậy nên mới tìm cái phương trình mặt phẳng để lưu lại). Và bước 3 thì áp dụng cái lisp tìm tâm vòng tròn trên mặt phẳng đó có tổng khoảng cách từ các điểm hình chiếu tới vòng tròn là nhỏ nhất bác ạ.
Tuy nó chưa thật đúng với cái bạn Duyminh yêu cầu nhưng mình nghĩ nó sẽ đơn giản hơn vì áp dụng được cái lisp trước đã làm (cho nó có hệ thống tư duy ấy mà) . Bởi vì tổng bình phương khoảng cách từ các điểm trong không gian tới vòng tròn tìm được có nhẽ cũng có thể hiểu gần đúng là tổng bình phương các khoảng cách từ các điểm tới mặt phẳng cộng tổng bình phương hình chiếu của đoạn thẳng nối trên mặt phẳng đó phải không bác. Mà mình đã chơi với hai thằng nhỏ nhất rùi thì chắc sẽ được cái bạn ấy yêu cầu.

Vì nghĩ vậy nên mình mới post cái phần xác định mặt phẳng đã xem ý ông chủ thớt ra sao, nhưng thấy im im nên chửa biết có nên làm tiếp hay không bác à.
Hề hề hề. Nếu Bác có giải thuật nào tốt hơn thì bày cho mình với. Mình mới nghĩ lôm côm được đến đó à, hề hề hề....

Hề hề hề...
Giải thuật và ý tưởng thì Thiep có, nhưng chiều nay Thiep lại đi công tác mất rồi, ngày cuối năm mới về VN lận. Theo Thiep thì chỉ cần 1 bước làm việc trong không gian 3D luôn.
Nối tiếp với giải thuật của bác, sau khi tìm được các thông số A, B, C, D; tiếp tục tìm tọa độ tâm O và bán kính R là của đường tròn đi qua p, p1, p2. Hai thông số này chắc là nhờ bác Bình hay các anh em Cadviet trợ giúp.
Không cần tìm thông số Ra, vì điều kiện Ra>=0.9 là không đúng vì Mp đi qua p, p1, p2 ban đầu là bất kỳ, so với mặt phẳng chuẩn (z=0) có thể góc hợp 2 mặt phẳng này >= 25độ
Tìm kc1 là khoảng cách ngắn nhất từ p0 đến MP Ax+By+Cz+D=0 (giống thông số kc của bác)
Gọi M là hình chiếu của p0 xuống mặt phẳng trên ta có:
MO = (sqrt(- (expt (distance p0 O) 2) (expt kc1 2) ))
kc = (abs (- MO R)). Đây mới là khoảng cách ngắn nhất từ p0 đến đường tròn tâm O đi qua 3 điểm p, p1, p2
…. (tiếp theo giải pháp của bác)
Sau khi tìm được tọa độ tâm O (pO) và R, vẽ đường tròn này:
(entmake '((0 . "CIRCLE") (10 pO) (40 . R) (210 . (A B C))))
Ok. Cầu chúc bác Bình tìm ra cái đường tròn này.
  • 1

#44 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 28 December 2010 - 02:25 PM

Các bác giúp em nhé.

Cám ơn các bác rất nhiều! :undecided:

Bạn xem thử đạt yêu cầu k?
Thật ra bài toán có phần cá biệt nên Mình không đi sâu vào giải thuật tối ưu để chương trình chạy nhanh hơn, nên khi tính bị lặp lại nhiều lần dẫn đến thời gian chạy máy dài....Có lẽ cái Bạn quan tâm ở đây là kết quả. Mình đã thử trên 1 số điểm, bạn thử lại với các điểm của Bạn xem sao. ở đây kết quả là 1 hình tròn đi qua 3 điểm đã cho mà tổng khoảng cách của tất cả các điểm đến đường tròn đó là min. Các Bạn có thể tiếp sức thêm cho Mình loại bỏ bớt các lần đã tính trong 3 vòng lặp.
Hy vọng sẽ đạt được mục đích của Bạn.

http://www.cadviet.c...s/3/tamvt3d.lsp
http://www.cadviet.c...es/3/tron_1.dwg
  • 1

#45 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 December 2010 - 12:09 PM

Hề hề hề...
Giải thuật và ý tưởng thì Thiep có, nhưng chiều nay Thiep lại đi công tác mất rồi, ngày cuối năm mới về VN lận. Theo Thiep thì chỉ cần 1 bước làm việc trong không gian 3D luôn.
Nối tiếp với giải thuật của bác, sau khi tìm được các thông số A, B, C, D; tiếp tục tìm tọa độ tâm O và bán kính R là của đường tròn đi qua p, p1, p2. Hai thông số này chắc là nhờ bác Bình hay các anh em Cadviet trợ giúp.
Không cần tìm thông số Ra, vì điều kiện Ra>=0.9 là không đúng vì Mp đi qua p, p1, p2 ban đầu là bất kỳ, so với mặt phẳng chuẩn (z=0) có thể góc hợp 2 mặt phẳng này >= 25độ
Tìm kc1 là khoảng cách ngắn nhất từ p0 đến MP Ax+By+Cz+D=0 (giống thông số kc của bác)
Gọi M là hình chiếu của p0 xuống mặt phẳng trên ta có:
MO = (sqrt(- (expt (distance p0 O) 2) (expt kc1 2) ))
kc = (abs (- MO R)). Đây mới là khoảng cách ngắn nhất từ p0 đến đường tròn tâm O đi qua 3 điểm p, p1, p2
…. (tiếp theo giải pháp của bác)
Sau khi tìm được tọa độ tâm O (pO) và R, vẽ đường tròn này:
(entmake '((0 . "CIRCLE") (10 pO) (40 . R) (210 . (A B C))))
Ok. Cầu chúc bác Bình tìm ra cái đường tròn này.

Hề hề hề,
Chào các bác, theo phương án bác Thiep đề nghị thì mình đã tìm được cái đường tròn đó và tâm của nó, Lisp cũng đã viết xong, nhưng có một vài thắc mắc "chưa biết hỏi ai" nên đành post lên đây nhờ các bác cho thêm ý kiến chỉ đạo.
1/- Lisp đã xác định được bán kinh và tâm đường tròn cần vẽ. Thậm chí cũng đã vẽ được một cái đường tròn đúng với bàn kính đã xác định. Tuy nhiên cái tâm của nó thì lại chạy đi tận Âu Mỹ chi đó mà mình chưa rõ tại sao.??? Khi zoom bản vẽ để thấy được cái đường tròn đó và dùng (entget(car(entsel))) để lấy các mã DXF của nó thì tọa độ tâm lại hoàn toàn đúng với cái tâm đã được xác định bằng lisp. Vậy mới kỳ chứ lị. Và nếu sử dụng lệnh move để move cái đường tròn này về đúng vị trí tâm đã xác định bằng lisp thì vòng tròn vừa khéo chạy qua 3 điểm đã xác định. Tuy nhiên nếu lấy mã DXF của vòng tròn đã bị move này thì cho ra cái tọa độ tâm khác với cái tâm đã xác định bằng lisp. Nhưng nếu lấy mã dxf của cái điểm tâm O này thì lại hoàn toàn đúng?????
Điều đó chứng tỏ cái vòng tròn được tạo ra hoàn toàn đúng với yêu cầu đã định, duy chỉ có cái thể hiện trên hình vẽ thì nó lại không như ý.
Việc tạo vòng tròn mình dùng cách mà bác Thiep đã dạy:
(entmake (list (cons 0 "circle") (cons 10 (last mau)) (cons 40 (nth 8 mau)) (cons 210 (list (nth 4 mau) (nth 5 mau) (nth 6 mau)))))
2/- Mình dùng lisp này áp dụng cho cái bản vẽ của bác DuơngTrungHuy gửi thì nó cho ra một vòng tròn khác với của bác Dương Trung Huy. Có nhẽ đây là do mình đã hạn chế chỉ xét các mặt phẳng nghiêng không quá 25 độ so với mặt phẳng z=0. (thực chất bạn Duyminh86 yêu cầu là nghiêng không quá 1 độ).
3/- Theo phương án mình đã đưa ra thì hiện tại mình gặp chút khó khăn là việc xáx định tọa độ điểm hình chiếu của một điểm xuống một lặt phẳng cho trước. Cái này bác nào còn nhớ thì gợi ý cho mình với nhé. Xin chân thành cám ơn trườc.....

Đây là cái lisp mình đã làm và cái bản vẽ của bác DuongTrungHuy mà mình đã test.

File lisp:
http://www.cadviet.c...uymatphang1.lsp

Trong file lisp này mình chưa thay thế hàm con (locpoint ssp) bằng hàm (acet-.........) mà bác Thiêp đã chỉ dạy.

(defun c:nsmp ( / olc lscir ssp p1 p2 lst lst1 lst2 p cir tkc pt pc kc d1 d2 d3 ra lst0)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq olc (getvar "cecolor"))
(setvar "osmode" 0)
(setq lscir (list))
(setq ssp (ssget (list (cons 0 "point")))) ;;; Chon tap hop diem

(locpoint ssp) ;;; Loc cac diem trung nhau

(setq lst0 lst)

(setvar "cecolor" "3")
(foreach e lst ;;; Bat dau tao cac to hop 3 diem
(setq lst1 (vl-remove e lst)
lst (vl-remove e lst)
p (cdr (assoc 10 (entget e)))
x (car p)
y (cadr p)
z (caddr p)
)
(foreach e1 lst1
(setq lst2 (vl-remove e1 lst1)
lst1 (vl-remove e1 lst1)
p1 (cdr (assoc 10 (entget e1)))
x1 (car p1)
y1 (cadr p1)
z1(caddr p1)
d1 (distance p p1)
)
(foreach e2 lst2
(setq p2 (cdr (assoc 10 (entget e2))))
(setq d2 (distance p1 p2)
d3 (distance p2 p)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
)
(if (and (< (+ d1 0.000001) (+ d2 d3)) (< (+ d2 0.000001) (+ d1 d3))
(< (+ d3 0.000001) (+ d1 d2))) ;;; Kiem tra 3 diem co thang hang khong

(progn ;;;; Lay cac thong so cua mat phang va vong tron qua 3 diem
;;; Su dung cac cong thuc trong hinh hoc giai tich
(setq ;;;;Xac dinh tham so cua mat phang
D (- (+ (* x (- (* y1 z2) (* y2 z1))) (* x1 (- (* y2 z) (* y z2)))
(* x2 (- (* y z1) (* y1 z)))))
A (+ (* y (- z1 z2)) (* y1 (- z2 z)) (* y2 (- z z1)))
B (+ (* z (- x1 x2)) (* z1 (- x2 x)) (* z2 (- x x1)))
C (+ (* x (- y1 y2)) (* x1 (- y2 y)) (* x2 (- y y1)))
;;; Xax dinh ban kinh vong tron qua ba diem dang xet
R (/ (sqrt (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (expt (- x2 x) 2) (expt (- y2 y) 2) (expt (- z2 z) 2))
) )
(* 2 (sqrt (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) ) )
)
;;; Xac dinh cac tham so phu de lay tam vong tron
h (/ (* (+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (* (- x x1) (- x x2)) (* (- y y1) (- y y2)) (* (- z z1) (- z z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h1 (/ (* (+ (expt (- x x2) 2) (expt (- y y2) 2) (expt (- z z2) 2))
(+ (* (- x1 x) (- x1 x2)) (* (- y1 y) (- y1 y2)) (* (- z1 z) (- z1 z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h2 (/ (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (* (- x2 x) (- x2 x1)) (* (- y2 y) (- y2 y1)) (* (- z2 z) (- z2 z1)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
;;; Xac dinh tam cua vong tron qua ba diem dang xet
O (list (+ (* h x) (* h1 x1) (* h2 x2))
(+ (* h y) (* h1 y1) (* h2 y2))
(+ (* h z) (* h1 z1) (* h2 z2))
)
)
)
)
(setq tkc 0)
(setq ra (abs (/ C (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))
;;;; Lay cos cua goc giua mat phang dang xet voi mat phang z=0
(if (>= ra 0.9 ) ;;;; Goc nghieng nho hon 25 do
(progn
(foreach e lst0
(setq pt (cdr (assoc 10 (entget e))))
(setq x0 (car pt)
y0 (cadr pt)
z0 (caddr pt)
)
(setq kc1 (abs (/ (+ (* A x0) (* B y0) (* C z0) D) (sqrt (+ (expt A 2)
(expt B 2) (expt C 2)))))) ;;; Khoang cach từ pt tơi mat phang
(setq kc (abs (- (sqrt (- (expt (distance pt O) 2) (expt kc1 2))) R)))
;;; Khoang cach tu pt toi vong tron
(setq tkc (+ tkc (expt kc 2)))
)
(if (= tkc 0)
(progn
(setq mau (list tkc p p1 p2 A B C D R O))
(ketthuc)
)
(setq lscir (append lscir (list (list tkc p p1 p2 A B C D R O))))
;;; Tao danh sach cac doi tuong va tham so can xet
)
)
)
)
)
)
(setq lscir (vl-sort lscir '(lambda (x y) (< (car x) (car y)) )) ) ;; Sap xep lai danh sach
(setq mau (car lscir))
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc ()
(alert (strcat "\n Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la: "
(rtos (car mau) 2 4)))
;;;; Tao cac doi tuong de kiem tra
(command "point" (cadr mau) )
(command "point" (caddr mau) )
(command "point" (cadddr mau) )
(command "point" (last mau))
(command "line" (cadr mau) (caddr mau) (cadddr mau) "c")
(entmake (list (cons 0 "circle") (cons 10 (last mau)) (cons 40 (nth 8 mau))
(cons 210 (list (nth 4 mau) (nth 5 mau) (nth 6 mau)))))
(alert (strcat "\n Mat phang tim duoc di qua ba diem la:" "\n P voi x = " (rtos (car (cadr mau)) 2 4)
"\n y = " (rtos (cadr (cadr mau)) 2 4) "\n z = " (rtos (caddr (cadr mau)) 2 4)
"\n P1 voi x1 = " (rtos (car (caddr mau)) 2 4)
"\n y1 = " (rtos (cadr (caddr mau)) 2 4) "\n z1 = " (rtos (caddr (caddr mau)) 2 4)
"\n P2 voi x2 = " (rtos (car (cadddr mau)) 2 4)
"\n y2 = " (rtos (cadr (cadddr mau)) 2 4) "\n z2 = " (rtos (caddr (cadddr mau)) 2 4)
"\n Phuong trinh mat phang la: "
"\n" (rtos (nth 4 mau) 2 2) " * x + " (rtos (nth 5 mau) 2 2) " * y + "
(rtos (nth 6 mau) 2 2) " * z + " (rtos (nth 7 mau) 2 2 ) " = 0 "
"\n Vong tron co tam la: (" (rtos (car (last mau)) 2 4) "," (rtos (cadr (last mau)) 2 4) ","
(rtos (caddr (last mau)) 2 4) ") ban kinh la : " (rtos (nth 8 mau) 2 4)
))

(setvar "osmode" oldos)
(setvar "cecolor" olc)
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun locpoint (ssp / lstpt i n e p)
(setq lstpt (list)
lst (list)
)
(if ssp
(progn
(setq i 0
n (sslength ssp)
)
(while (< i n)
(setq e (ssname ssp i))
(setq p (cdr (assoc 10 (entget e))))
(if (not (member p lstpt))
(progn
(setq lstpt (append lstpt (list p)))
(setq lst (append lst (list e)))
)
;;;;;(command "erase" e "")
(entdel e)
)
(setq i (1+ i))
)
)
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



File bản vẽ:
http://www.cadviet.c.../3/tron_1_1.dwg

Trên bản vẽ này, các điểm đỏ và cái vòng tròn màu blue là của bác DuongTrungHuy, còn các điểm màu Green là do lisp của mình tạo ra gồm có ba điểm xác định mặt phẳng và điểm O tâm của vòng tròn đi qua ba điểm đó. Một vòng tròn màu Green là do lisp tạo ra, nhìn không thấy trúng với tâm đã xác định nhưng nều lấy mã dxf của nó sẽ thấy tâm trùng với điểm tâm đã xác định ở trên. Các bác có thể dùng lệnh move để kiểm tra sẽ thấy những điều mình đã nói phía trên.
Cái tam giác màu Green do lisp của mình tạo ra chỉ để hình dung cái mặt phẳng do 3 điểm đã xác định ở trên tạo ra mà thôi.
Rất mong các bác xem xét kỹ và góp ý để hoàn thiện bài toán này...

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 30 December 2010 - 03:34 PM
Bo sung chu thich cho lisp

  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#46 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 30 December 2010 - 01:40 PM

Bác ạ, sau khi xem xét kỹ lisp của bác thì e nhận ra là .... nó dài quá ..mà lại không có ghi chú nhiệm vụ từng đoạn, nên để 1 người không bắt tay làm lisp này từ đầu thì cũng mất kha khá thời gian --> Suy ra là e quyết định spam 1 cái rồi đi ra, mong bác đừng giận :D ^^
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#47 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 30 December 2010 - 01:54 PM

3/- Theo phương án mình đã đưa ra thì hiện tại mình gặp chút khó khăn là việc xáx định tọa độ điểm hình chiếu của một điểm xuống một lặt phẳng cho trước. Cái này bác nào còn nhớ thì gợi ý cho mình với nhé. Xin chân thành cám ơn trườc.....


Chưa hiểu hết mục đích của Bạn nhưng Bạn co thể theo hướng này được không?

Khoảng cách của điểm P đến mặt phẳng 3 điểm A,B,C x/định như sau:
- Chuyển trục tọa độ thế giới về mặt phẳng (A B C)
- Chuyển tọa độ thế giới của P sang tọa độ địa phương của (A B C)
- Khoảng cách từ P đến (A B C) là tọa độ z mới.
..v.v... Bạn có thể khai thác thêm những thông số bạn cần (như chân đường cao H của P ...)
Trong chương trình Mình có dùng 1 số hàm của CAD để chuyển đổi tọa độ giữa các hệ.
Hy vọng Bạn sẽ thành công với bài toán này.
  • 1

#48 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 30 December 2010 - 02:28 PM

3/- Theo phương án mình đã đưa ra thì hiện tại mình gặp chút khó khăn là việc xáx định tọa độ điểm hình chiếu của một điểm xuống một lặt phẳng cho trước. Cái này bác nào còn nhớ thì gợi ý cho mình với nhé. Xin chân thành cám ơn trườc.....

Bác đã lập được phương trình mặt phẳng này chưa ạ ^^.Nếu lập được dạng ax+by+cz+d = 0 rồi thì đẹp.Vì vectơ pháp tuyến của mặt phẳng này là
[a
b
c] ,còn vectơ từ điểm chân đường cao (x1,y1,z1) đến điểm cho trước (zo,yo,zo) là

- [x1-xo
y1-yo
z1-zo]
Cho 2 vectơ này trùng luôn lên nhau thì ra x1,y1,z1 ạ.E nhớ láng máng thế,hok biết có gì sai k ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#49 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 December 2010 - 03:11 PM

Bác đã lập được phương trình mặt phẳng này chưa ạ ^^.Nếu lập được dạng ax+by+cz+d = 0 rồi thì đẹp.Vì vectơ pháp tuyến của mặt phẳng này là
[a
b
c] ,còn vectơ từ điểm chân đường cao (x1,y1,z1) đến điểm cho trước (zo,yo,zo) là

- [x1-xo
y1-yo
z1-zo]
Cho 2 vectơ này trùng luôn lên nhau thì ra x1,y1,z1 ạ.E nhớ láng máng thế,hok biết có gì sai k ^^

Hề hề hề,
Thực ra không phải là trùng nhau bác ketxu ạ. Mà là véc tơ (x1-x0, y1-y0, z1-z0) bằng k lần véc tơ (a, b, c) bác ạ.
Mình cũng đã làm theo hướng này và nó cho ra một cái công thức dài loằng ngoằng như sau. Chửa biết đúng sai thế nào, nhờ các bác kiểm tra lại giùm nhé:
x0 = (x1 (B^2 + C^2) - A*B*y1 - A*C*z1 - A*D)/(A^2 + B^2 + C^2)
y0 = (y1 (C^2 + A^2) - B*C*z1 - B*A*x1 - B*D)/(A^2 + B^2 + C^2)
z0 = (z1 (A^2 + B^2) - C*A*x1 - C*B*y1 - C*D)/(A^2 + B^2 + C^2)

Vấn đề còn lại nếu như các công thức xác định tọa độ trên là đúng thì mình nghĩ có thể vượt qua được.

Về việc bác nói, thiệt tình mong bác thông cảm, chả phải là mình có ý đánh đố mọi người đâu mà thực ra là vì cái lisp này mình cứ dựa vào các lisp cũ rồi copy cắt dán từng phần theo cái suy nghĩ của từng bước một mà thôi nên cũng chưa giải thích rõ được cho mọi người các bước cụ thể. Mình sẽ bổ sung ngay. Bác đừng giận.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#50 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 30 December 2010 - 03:42 PM

À vâng,e quên mất hệ số k ^^.
Công thức đúng hay không thì bác làm 1 phát kiểm tra khoảng cách từ điểm đó tới điểm chiếu trên mp nữa.Nếu nó đúng bằng khoảng cách từ điểm 0 tới mặt phẳng (A.x0 + B.y0 + C.z0 + D)/sqrt(A^2+B^2+C^2) thì chắc là không phải ngợi nữa bác ạ (0(x0,y0,z0) là điểm đã cho ý ạ)
P/S lại lần nữa : e còn nhỏ tuổi,bác gọi thế e ế vợ mất :|
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#51 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 December 2010 - 05:02 PM

Chưa hiểu hết mục đích của Bạn nhưng Bạn co thể theo hướng này được không?

Khoảng cách của điểm P đến mặt phẳng 3 điểm A,B,C x/định như sau:
- Chuyển trục tọa độ thế giới về mặt phẳng (A B C)
- Chuyển tọa độ thế giới của P sang tọa độ địa phương của (A B C)
- Khoảng cách từ P đến (A B C) là tọa độ z mới.
..v.v... Bạn có thể khai thác thêm những thông số bạn cần (như chân đường cao H của P ...)
Trong chương trình Mình có dùng 1 số hàm của CAD để chuyển đổi tọa độ giữa các hệ.
Hy vọng Bạn sẽ thành công với bài toán này.

Chào bác Duong Trung Huy,
Mình test thử cái lisp của bác thì nó bào ; error: no function definition: CAL
Có nhẽ bác quên upload cả cái hàm con (Cal "w2u(d1)") mà chắc bác dùng để đổi hệ trục tọa độ hay sao ấy.
Nhờ bác up cái hàm ấy lên để mình tham khảo với.
Cám ơn bác trước...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#52 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 30 December 2010 - 05:14 PM

Chào bác Duong Trung Huy,
Mình test thử cái lisp của bác thì nó bào ; error: no function definition: CAL
Có nhẽ bác quên upload cả cái hàm con (Cal "w2u(d1)") mà chắc bác dùng để đổi hệ trục tọa độ hay sao ấy.
Nhờ bác up cái hàm ấy lên để mình tham khảo với.
Cám ơn bác trước...


à nó ở trong file geomcal.arx của Cad ở thư mục Program nơi Bạn cài Acad.Bạn load thử xem có được k?
(Diễn đàn trục trặc không up được!)
  • 1

#53 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 December 2010 - 06:25 PM

à nó ở trong file geomcal.arx của Cad ở thư mục Program nơi Bạn cài Acad.Bạn load thử xem có được k?
(Diễn đàn trục trặc không up được!)

Chào bác PhamThanhBinh, bác DuongTrungHuy
Bác nên kiểm tra geomcal.arx đã được Load chưa? Nếu Load rồi thì thôi, Nếu chưa thì phải Load nó vào bằng hàm arxload

(if (not cal) (arxload "geomcal"))


Vì nó tự Load vào khi user đánh lệnh Cal. Còn khi mà User chưa gõ lệnh Cal thì nó chưa được Load vào.
Vì thế nên kiểm tra như ở trên.
Bác Bình bị cái lỗi này cũng là vì thế :D
  • 2

#54 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 January 2011 - 02:11 PM

Chào bác PhamThanhBinh, bác DuongTrungHuy
Bác nên kiểm tra geomcal.arx đã được Load chưa? Nếu Load rồi thì thôi, Nếu chưa thì phải Load nó vào bằng hàm arxload

(if (not cal) (arxload "geomcal"))


Vì nó tự Load vào khi user đánh lệnh Cal. Còn khi mà User chưa gõ lệnh Cal thì nó chưa được Load vào.
Vì thế nên kiểm tra như ở trên.
Bác Bình bị cái lỗi này cũng là vì thế :D

Cám ơn bác Tue_NV và bác DuongTrung Huy đã chỉ dẫn.
Dựa vào đó mình đã chỉnh lại cái lisp phía trên để vòng tròn vẽ được xuất hiện đúng vị trí của nó bằng hàm command. Cò sử dụng hàm entmake thì mình vẫn chưa làm được, rất mong mọi người góp ý.

(defun c:nsmp ( / olc lscir ssp p1 p2 lst lst1 lst2 p cir tkc pt pc kc d1 d2 d3 ra lst0)
(if (not cal) (arxload "geomcal"))
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq olc (getvar "cecolor"))
(setvar "osmode" 0)
(setq lscir (list))
(setq ssp (ssget (list (cons 0 "point"))))

(locpoint ssp)

(setq lst0 lst)

(setvar "cecolor" "3")
(foreach e lst
(setq lst1 (vl-remove e lst)
lst (vl-remove e lst)
p (cdr (assoc 10 (entget e)))
x (car p)
y (cadr p)
z (caddr p)
)
(foreach e1 lst1
(setq lst2 (vl-remove e1 lst1)
lst1 (vl-remove e1 lst1)
p1 (cdr (assoc 10 (entget e1)))
x1 (car p1)
y1 (cadr p1)
z1(caddr p1)
d1 (distance p p1)
)
(foreach e2 lst2
(setq p2 (cdr (assoc 10 (entget e2))))
(setq d2 (distance p1 p2)
d3 (distance p2 p)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
)
(if (and (< (+ d1 0.000001) (+ d2 d3)) (< (+ d2 0.000001) (+ d1 d3))
(< (+ d3 0.000001) (+ d1 d2)))

(progn
(setq D (- (+ (* x (- (* y1 z2) (* y2 z1))) (* x1 (- (* y2 z) (* y z2)))
(* x2 (- (* y z1) (* y1 z)))))
A (+ (* y (- z1 z2)) (* y1 (- z2 z)) (* y2 (- z z1)))
B (+ (* z (- x1 x2)) (* z1 (- x2 x)) (* z2 (- x x1)))
C (+ (* x (- y1 y2)) (* x1 (- y2 y)) (* x2 (- y y1)))
R (/ (sqrt (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (expt (- x2 x) 2) (expt (- y2 y) 2) (expt (- z2 z) 2))
) )
(* 2 (sqrt (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) ) )
)
h (/ (* (+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (* (- x x1) (- x x2)) (* (- y y1) (- y y2)) (* (- z z1) (- z z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h1 (/ (* (+ (expt (- x x2) 2) (expt (- y y2) 2) (expt (- z z2) 2))
(+ (* (- x1 x) (- x1 x2)) (* (- y1 y) (- y1 y2)) (* (- z1 z) (- z1 z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h2 (/ (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (* (- x2 x) (- x2 x1)) (* (- y2 y) (- y2 y1)) (* (- z2 z) (- z2 z1)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
O (list (+ (* h x) (* h1 x1) (* h2 x2))
(+ (* h y) (* h1 y1) (* h2 y2))
(+ (* h z) (* h1 z1) (* h2 z2))
)
)
)
)
(setq tkc 0)
(setq ra (abs (/ C (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))
(if (>= ra 0.9 )
(progn
(foreach e lst0
(setq pt (cdr (assoc 10 (entget e))))
(setq x0 (car pt)
y0 (cadr pt)
z0 (caddr pt)
)
(setq kc1 (abs (/ (+ (* A x0) (* B y0) (* C z0) D) (sqrt (+ (expt A 2) (expt B 2)
(expt C 2))))))
(setq kc (abs (- (sqrt (- (expt (distance pt O) 2) (expt kc1 2))) R)))
(setq tkc (+ tkc (expt kc 2)))
)
(if (= tkc 0)
(progn
(setq mau (list tkc p p1 p2 A B C D R O))
(ketthuc)
)
(setq lscir (append lscir (list (list tkc p p1 p2 A B C D R O))))
)
)
)
)
)
)
(setq lscir (vl-sort lscir '(lambda (x y) (< (car x) (car y)) )) )
(setq mau (car lscir))
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc ()
(alert (strcat "\n Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la: " (rtos (car mau) 2 4)))

(command "point" (cadr mau) )
(command "point" (caddr mau) )
(command "point" (cadddr mau) )
(command "point" (last mau))
(setq O1 (last mau))
(command "line" (cadr mau) (caddr mau) (cadddr mau) "c")
(command "UCS" 3 (cadr mau) (caddr mau) (cadddr mau) )
(setq O1 (Cal "w2u (O1)"))
;;;;(entmake (list (cons 0 "circle") (cons 10 O1) (cons 40 (nth 8 mau)) (cons 210 (list (nth 4 mau)
(nth 5 mau) (nth 6 mau)))))
(command "circle" O1 (nth 8 mau))

(alert (strcat "\n Mat phang tim duoc di qua ba diem la:" "\n P voi x = " (rtos (car (cadr mau)) 2 4)
"\n y = " (rtos (cadr (cadr mau)) 2 4) "\n z = " (rtos (caddr (cadr mau)) 2 4)
"\n P1 voi x1 = " (rtos (car (caddr mau)) 2 4)
"\n y1 = " (rtos (cadr (caddr mau)) 2 4) "\n z1 = " (rtos (caddr (caddr mau)) 2 4)
"\n P2 voi x2 = " (rtos (car (cadddr mau)) 2 4)
"\n y2 = " (rtos (cadr (cadddr mau)) 2 4) "\n z2 = " (rtos (caddr (cadddr mau)) 2 4)
"\n Phuong trinh mat phang la: "
"\n" (rtos (nth 4 mau) 2 2) " * x + " (rtos (nth 5 mau) 2 2) " * y + " (rtos (nth 6 mau) 2 2) " * z + "
(rtos (nth 7 mau) 2 2 ) " = 0 "
"\n Vong tron co tam la: (" (rtos (car (last mau)) 2 4) "," (rtos (cadr (last mau)) 2 4) ","
(rtos (caddr (last mau)) 2 4) ") ban kinh la : " (rtos (nth 8 mau) 2 4) ))

(setvar "osmode" oldos)
(setvar "cecolor" olc)
(command "undo" "e")
(command "UCS" "W")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun locpoint (ssp / lstpt i n e p)
(setq lstpt (list)
lst (list)
)
(if ssp
(progn
(setq i 0
n (sslength ssp)
)
(while (< i n)
(setq e (ssname ssp i))
(setq p (cdr (assoc 10 (entget e))))
(if (not (member p lstpt))
(progn
(setq lstpt (append lstpt (list p)))
(setq lst (append lst (list e)))
)
;;;;;(command "erase" e "")
(entdel e)
)
(setq i (1+ i))
)
)
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;






;;


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#55 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 07 January 2011 - 09:47 AM

Cám ơn bác Tue_NV và bác DuongTrung Huy đã chỉ dẫn.
Dựa vào đó mình đã chỉnh lại cái lisp phía trên để vòng tròn vẽ được xuất hiện đúng vị trí của nó bằng hàm command. Cò sử dụng hàm entmake thì mình vẫn chưa làm được, rất mong mọi người góp ý.


(defun c:nsmp ( / olc lscir ssp p1 p2 lst lst1 lst2 p cir tkc pt pc kc d1 d2 d3 ra lst0)
(if (not cal) (arxload "geomcal"))
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq olc (getvar "cecolor"))
(setvar "osmode" 0)
(setq lscir (list))
(setq ssp (ssget (list (cons 0 "point"))))

(locpoint ssp)

(setq lst0 lst)

(setvar "cecolor" "3")
(foreach e lst
(setq lst1 (vl-remove e lst)
lst (vl-remove e lst)
p (cdr (assoc 10 (entget e)))
x (car p)
y (cadr p)
z (caddr p)
)
(foreach e1 lst1
(setq lst2 (vl-remove e1 lst1)
lst1 (vl-remove e1 lst1)
p1 (cdr (assoc 10 (entget e1)))
x1 (car p1)
y1 (cadr p1)
z1(caddr p1)
d1 (distance p p1)
)
(foreach e2 lst2
(setq p2 (cdr (assoc 10 (entget e2))))
(setq d2 (distance p1 p2)
d3 (distance p2 p)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
)
(if (and (< (+ d1 0.000001) (+ d2 d3)) (< (+ d2 0.000001) (+ d1 d3))
(< (+ d3 0.000001) (+ d1 d2)))

(progn
(setq D (- (+ (* x (- (* y1 z2) (* y2 z1))) (* x1 (- (* y2 z) (* y z2)))
(* x2 (- (* y z1) (* y1 z)))))
A (+ (* y (- z1 z2)) (* y1 (- z2 z)) (* y2 (- z z1)))
B (+ (* z (- x1 x2)) (* z1 (- x2 x)) (* z2 (- x x1)))
C (+ (* x (- y1 y2)) (* x1 (- y2 y)) (* x2 (- y y1)))
R (/ (sqrt (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (expt (- x2 x) 2) (expt (- y2 y) 2) (expt (- z2 z) 2))
) )
(* 2 (sqrt (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) ) )
)
h (/ (* (+ (expt (- x1 x2) 2) (expt (- y1 y2) 2) (expt (- z1 z2) 2))
(+ (* (- x x1) (- x x2)) (* (- y y1) (- y y2)) (* (- z z1) (- z z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h1 (/ (* (+ (expt (- x x2) 2) (expt (- y y2) 2) (expt (- z z2) 2))
(+ (* (- x1 x) (- x1 x2)) (* (- y1 y) (- y1 y2)) (* (- z1 z) (- z1 z2)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
h2 (/ (* (+ (expt (- x x1) 2) (expt (- y y1) 2) (expt (- z z1) 2))
(+ (* (- x2 x) (- x2 x1)) (* (- y2 y) (- y2 y1)) (* (- z2 z) (- z2 z1)))
)
(* 2 (+ (expt (- (* (- y y1) (- z1 z2)) (* (- z z1) (- y1 y2))) 2)
(expt (- (* (- z z1) (- x1 x2)) (* (- x x1) (- z1 z2))) 2)
(expt (- (* (- x x1) (- y1 y2)) (* (- y y1) (- x1 x2))) 2)
) )
)
O (list (+ (* h x) (* h1 x1) (* h2 x2))
(+ (* h y) (* h1 y1) (* h2 y2))
(+ (* h z) (* h1 z1) (* h2 z2))
)
)
)
)
(setq tkc 0)
(setq ra (abs (/ C (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))
(if (>= ra 0.9 )
(progn
(foreach e lst0
(setq pt (cdr (assoc 10 (entget e))))
(setq x0 (car pt)
y0 (cadr pt)
z0 (caddr pt)
)
(setq kc1 (abs (/ (+ (* A x0) (* B y0) (* C z0) D) (sqrt (+ (expt A 2) (expt B 2)
(expt C 2))))))
(setq kc (abs (- (sqrt (- (expt (distance pt O) 2) (expt kc1 2))) R)))
(setq tkc (+ tkc (expt kc 2)))
)
(if (= tkc 0)
(progn
(setq mau (list tkc p p1 p2 A B C D R O))
(ketthuc)
)
(setq lscir (append lscir (list (list tkc p p1 p2 A B C D R O))))
)
)
)
)
)
)
(setq lscir (vl-sort lscir '(lambda (x y) (< (car x) (car y)) )) )
(setq mau (car lscir))
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc ()
(alert (strcat "\n Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la: " (rtos (car mau) 2 4)))

(command "point" (cadr mau) )
(command "point" (caddr mau) )
(command "point" (cadddr mau) )
(command "point" (last mau))
(setq O1 (last mau))
(command "line" (cadr mau) (caddr mau) (cadddr mau) "c")
(command "UCS" 3 (cadr mau) (caddr mau) (cadddr mau) )
(setq O1 (Cal "w2u (O1)"))
;;;;(entmake (list (cons 0 "circle") (cons 10 O1) (cons 40 (nth 8 mau)) (cons 210 (list (nth 4 mau)
(nth 5 mau) (nth 6 mau)))))
(command "circle" O1 (nth 8 mau))

(alert (strcat "\n Mat phang tim duoc di qua ba diem la:" "\n P voi x = " (rtos (car (cadr mau)) 2 4)
"\n y = " (rtos (cadr (cadr mau)) 2 4) "\n z = " (rtos (caddr (cadr mau)) 2 4)
"\n P1 voi x1 = " (rtos (car (caddr mau)) 2 4)
"\n y1 = " (rtos (cadr (caddr mau)) 2 4) "\n z1 = " (rtos (caddr (caddr mau)) 2 4)
"\n P2 voi x2 = " (rtos (car (cadddr mau)) 2 4)
"\n y2 = " (rtos (cadr (cadddr mau)) 2 4) "\n z2 = " (rtos (caddr (cadddr mau)) 2 4)
"\n Phuong trinh mat phang la: "
"\n" (rtos (nth 4 mau) 2 2) " * x + " (rtos (nth 5 mau) 2 2) " * y + " (rtos (nth 6 mau) 2 2) " * z + "
(rtos (nth 7 mau) 2 2 ) " = 0 "
"\n Vong tron co tam la: (" (rtos (car (last mau)) 2 4) "," (rtos (cadr (last mau)) 2 4) ","
(rtos (caddr (last mau)) 2 4) ") ban kinh la : " (rtos (nth 8 mau) 2 4) ))

(setvar "osmode" oldos)
(setvar "cecolor" olc)
(command "undo" "e")
(command "UCS" "W")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun locpoint (ssp / lstpt i n e p)
(setq lstpt (list)
lst (list)
)
(if ssp
(progn
(setq i 0
n (sslength ssp)
)
(while (< i n)
(setq e (ssname ssp i))
(setq p (cdr (assoc 10 (entget e))))
(if (not (member p lstpt))
(progn
(setq lstpt (append lstpt (list p)))
(setq lst (append lst (list e)))
)
;;;;;(command "erase" e "")
(entdel e)
)
(setq i (1+ i))
)
)
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;

Chào bác Thanh bình và DuongTrungHuy, sau khi đọc xong 2 lisp của 2 bác, Thiep có vài nhận xét sau:
*Lisp của Thanhbinh
- cho kết quả khác với lisp của DuongTrungHuy!!!
- chạy nhanh hơn rất nhiều so với lisp của DuongTrungHuy, có lẽ do lisp của DuongTrungHuy có dòng lệnh (command "UCS" 3 d1 d2 d3) và không loại trừ các tọa độ point đã xét ở vòng lặp ngoài bằng hàm vl-remove như Thanhbinh
- không cần tìm R bằng công thức vì sau khi tìm được tọa độ O (nếu có) thì R = (distance 0 p)
- Thiep cũng chưa biết tại sao cái vòng tròn được tạo bằng hàm Entmake nó lại chạy đi chơi chỗ khác! tuy nhiên cũng có giải pháp khác:
(setq obcir (vla-addcircle mspace (vlax-3d-point O) R))
(vla-put-normal obcir (vlax-3d-point(list (nth 4 mau) (nth 5 mau) (nth 6 mau))))
(vla-put-color obcir ...)
lúc này không cần dùng hàm CAL nữa.
* Lisp của DuongTrungHuy:
- chạy rất rất chậm mặc dù Thiep thử chỉ khoảng 30 điểm.
- cái đường tròn do lisp của DuongTrungHuy tạo ra chuẩn hơn lisp của Thanhbinh.
- bạn đã rất khéo tạo điều kiện để sử dụng hàm ACET-GEOM-ARC-CENTER, bằng cách dùng dòng lệnh (command "UCS" 3 d1 d2 d3) và (Cal "w2u(d1)")... tuy nhiên cả bạn và Thanhbinh có sai sót khi khi không xét đến trường hợp có 3 điểm thẳng hàng, khi đó hàm ACET-GEOM-ARC-CENTER trả về nil, khi đó 2 bác phải dùng hàm: if tamO (hay O)
Một vài dòng suy nghĩ, chúc 2 bác khoẻ.
  • 1

#56 duyminh86

duyminh86

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 15 January 2011 - 03:33 PM

Các bác thật là nhiệt tình tham gia topic của em, cám ơn các bác.

em thấy chương trình của bác Thanhbinh và của bác DuongTrungHuy đều rất OK, tuy có điều em rất hay gặp trường hợp hàm trả về nil, đồng thời rất hay gặp lỗi no function definition: CAL khi dùng chương trình của bác DuongTrungHuy, sau khi thêm dòng lệnh load lệnh CAL vào thì vấn đề được khắc phục, Chương trình của bác Thanhbinh rất hay khi làm theo phương pháp tính bình phương tối thiểu, nhưng hay gặp lỗi no function definition: LOCPOINT, các bác hoàn thiện giúp em với nhé.

em có ý kiến thế này các bác xem xét xem, khi nội suy trong không gian 3D, mình đưa các điểm về mặt phẳng XY rồi nội suy trong mặt phẳng. Các bác thấy có ổn ko (mặc dù phải thay đổi hệ trục tọa độ ban đầu, nếu ko phải thay đổi thì tốt quá)

có 1 điều nữa là chương trình ko nhận diện được điểm dạng chữ thập (+) hoặc điểm dạng hình cầu trong không gian. Các bác giúp em nhận diện những dạng điểm này với nhé.

Cám ơn các bác rất nhiều.
  • 0

#57 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 17 January 2011 - 10:35 AM

Các bác thật là nhiệt tình tham gia topic của em, cám ơn các bác.

em thấy chương trình của bác Thanhbinh và của bác DuongTrungHuy đều rất OK, tuy có điều em rất hay gặp trường hợp hàm trả về nil, đồng thời rất hay gặp lỗi no function definition: CAL khi dùng chương trình của bác DuongTrungHuy, sau khi thêm dòng lệnh load lệnh CAL vào thì vấn đề được khắc phục, Chương trình của bác Thanhbinh rất hay khi làm theo phương pháp tính bình phương tối thiểu, nhưng hay gặp lỗi no function definition: LOCPOINT, các bác hoàn thiện giúp em với nhé.

em có ý kiến thế này các bác xem xét xem, khi nội suy trong không gian 3D, mình đưa các điểm về mặt phẳng XY rồi nội suy trong mặt phẳng. Các bác thấy có ổn ko (mặc dù phải thay đổi hệ trục tọa độ ban đầu, nếu ko phải thay đổi thì tốt quá)

có 1 điều nữa là chương trình ko nhận diện được điểm dạng chữ thập (+) hoặc điểm dạng hình cầu trong không gian. Các bác giúp em nhận diện những dạng điểm này với nhé.

Cám ơn các bác rất nhiều.

Xin lỗi các bác vì cuối năm Thiep bận việc quá,
Dựa trên thuật toán của bác ThanhBinh và của DuongTrungHuy, Thiep cho ra lò 1 cái lisp bằng cách "xào nấu" và thêm một chút gia vị 2 lisp của 2 bác.
Lisp này không cần tính toán các thông số A, B, C, D như ThanhBinh, Lisp này cũng chuyển hệ trục tọa độ nhưng không dùng dòng lệnh (command "UCS" 3 d1 d2 d3) và lệnh Cal như DuongTrungHuy.
Lisp này chạy nhanh hơn lisp của bác Thanhbinh một chút, nhanh hơn nhiều lisp của DuongTrungHuy, và xác định được vòng tròn chuẩn như lisp của DuongTrungHuy.
;;; free lisp from cadviet.com by thiep
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;-------------------------------
(defun addLWP (Lp *Model* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun c:nsmT (/ doc mspace ucs_all ucsObjtem oldos
olc lscir lst0 lst lst1 lst2
pUCS p1UCS p2UCS cent R origpo
kc1 kc2 kc3^2 tkc LineOBJtemp
mau tg
)

(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(setq mspace (vla-get-modelspace doc)
ucs_all (vla-get-UserCoordinateSystems doc)
)

(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq olc (getvar "cecolor"))
(setvar "osmode" 0)
(setvar "UCSICON" 0)
(setq lscir (list))
(setq lst (ACET-LIST-REMOVE-DUPLICATES
(mapcar '(lambda (x) (DXF 10 x))
(ACET-SS-TO-LIST (ssget '((0 . "point"))))
)
0.1
)
)
(setq tg (getvar "date"))
(setq Now (* 86400.0 (- tg (fix tg))))
(setq lst0 lst)
(setvar "cecolor" "3")
(foreach p lst
(setq lst1 (vl-remove p lst)
lst (vl-remove p lst)
)
(foreach p1 lst1
(setq lst2 (vl-remove p1 lst1)
lst1 (vl-remove p1 lst1)
)
(foreach p2 lst2
(setq LineOBJtemp
(vla-addline
mspace
(vlax-3d-point p)
(vlax-3d-point p1)
)
)
(setq origpo (vlax-curve-getClosestPointTo LineOBJtemp p2 t))
(if (equal (abs (acet-geom-vector-d-angle
(ACET-GEOM-UNIT-VECTOR p1 origpo)
(ACET-GEOM-UNIT-VECTOR origpo p2)
)
)
(/ pi 2)
0.01
)
(cond ((/= origpo p1)
(setq ucsObjtem (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p1)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
((= origpo p1)
(setq ucsObjtem (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
)
)
(vla-delete LineOBJtemp)
(vla-put-ActiveUCS doc ucsObjtem)
(setq pUCS (trans p 0 1)
p1UCS (trans p1 0 1)
p2UCS (trans p2 0 1)
cent (acet-geom-arc-center pUCS p1UCS p2UCS)
)
(if cent
(setq R (distance cent p2UCS))
)
(setq tkc 0)
(foreach pt lst0
(setq ptUCS (trans pt 0 1)
kc1 (caddr ptUCS)
kc2 (- (sqrt (- (expt (distance ptUCS cent) 2) (expt kc1 2)))
R
)
kc3^2 (+ (expt kc2 2) (expt kc1 2))
)
(setq tkc (+ tkc kc3^2))
)
(setq
lscir (append lscir
(list (list tkc p p1 p2 origpo R cent))
)
)

)
)
)
(setq lscir (vl-sort lscir '(lambda (x y) (< (car x) (car y))))
mau (car lscir)
)
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc (/ p p1 p2 origpo R cent ucsObj
pUCS p1UCS p2UCS LstLWP LWP nor obcir
tg
)
;;; (alert
;;; (strcat
;;; "\n Tong cac binh phuong khoang cach tu cac diem toi vong tron tim duoc la: "
;;; (rtos (car mau) 2 4)
;;; )
;;; )
(acet-ucs-cmd (list "w"))
(setq p (nth 1 mau)
p1 (nth 2 mau)
p2 (nth 3 mau)
origpo (nth 4 mau)
R (nth 5 mau)
cent (nth 6 mau)
)
(if (equal (abs (acet-geom-vector-d-angle
(ACET-GEOM-UNIT-VECTOR p1 origpo)
(ACET-GEOM-UNIT-VECTOR origpo p2)
)
)
(/ pi 2)
0.01
)
(cond ((/= origpo p1)
(setq ucsObj (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p1)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
((= origpo p1)
(setq ucsObj (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
)
)
(vla-put-ActiveUCS doc ucsObj)
(setq pUCS (trans p 0 1)
p1UCS (trans p1 0 1)
p2UCS (trans p2 0 1)
)
(setq LstLWP (list (car pUCS)
(cadr pUCS)
(car p1UCS)
(cadr p1UCS)
(car p2UCS)
(cadr p2UCS)
)
LWP (addLWP LstLWP mspace)
nor (vla-get-Normal LWP)
obcir (vla-addcircle mspace (vlax-3d-point (trans cent 1 0)) R)
)
(vla-put-Normal obcir nor)
(vla-put-color obcir 4)
(vla-delete LWP)
(setvar "UCSICON" 1)
(setvar "osmode" oldos)
(setvar "cecolor" olc)
(command "undo" "e")
(acet-ucs-cmd '("w"))
(setq tg (getvar "date"))
(alert (strcat "Tông thoi gian chay lisp là :"
(rtos (- (* 86400.0 (- tg (fix tg))) Now))
" giây."
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Chào Duyminh86, cái gọi là điểm dạng chữ thập (+) hoặc điểm dạng hình cầu như bạn nói thì điểm này do đối tượng gì tạo ra: - 2 line cắt nhau? dạng TEXT?, điểm là tâm của hình cầu?... bạn nói rõ thêm nhé.
Chúc các bạn vui trong những ngày cuối năm!
  • 1

#58 duyminh86

duyminh86

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 January 2011 - 04:26 PM

Xin lỗi các bác vì cuối năm Thiep bận việc quá,
Dựa trên thuật toán của bác ThanhBinh và của DuongTrungHuy, Thiep cho ra lò 1 cái lisp bằng cách "xào nấu" và thêm một chút gia vị 2 lisp của 2 bác.
Lisp này không cần tính toán các thông số A, B, C, D như ThanhBinh, Lisp này cũng chuyển hệ trục tọa độ nhưng không dùng dòng lệnh (command "UCS" 3 d1 d2 d3) và lệnh Cal như DuongTrungHuy.
Lisp này chạy nhanh hơn lisp của bác Thanhbinh một chút, nhanh hơn nhiều lisp của DuongTrungHuy, và xác định được vòng tròn chuẩn như lisp của DuongTrungHuy.

;;; free lisp from cadviet.com by thiep
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;-------------------------------
(defun addLWP (Lp *Model* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun c:nsmT (/ doc mspace ucs_all ucsObjtem oldos
olc lscir lst0 lst lst1 lst2
pUCS p1UCS p2UCS cent R origpo
kc1 kc2 kc3^2 tkc LineOBJtemp
mau tg
)

(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(setq mspace (vla-get-modelspace doc)
ucs_all (vla-get-UserCoordinateSystems doc)
)

(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq olc (getvar "cecolor"))
(setvar "osmode" 0)
(setvar "UCSICON" 0)
(setq lscir (list))
(setq lst (ACET-LIST-REMOVE-DUPLICATES
(mapcar '(lambda (x) (DXF 10 x))
(ACET-SS-TO-LIST (ssget '((0 . "point"))))
)
0.1
)
)
(setq tg (getvar "date"))
(setq Now (* 86400.0 (- tg (fix tg))))
(setq lst0 lst)
(setvar "cecolor" "3")
(foreach p lst
(setq lst1 (vl-remove p lst)
lst (vl-remove p lst)
)
(foreach p1 lst1
(setq lst2 (vl-remove p1 lst1)
lst1 (vl-remove p1 lst1)
)
(foreach p2 lst2
(setq LineOBJtemp
(vla-addline
mspace
(vlax-3d-point p)
(vlax-3d-point p1)
)
)
(setq origpo (vlax-curve-getClosestPointTo LineOBJtemp p2 t))
(if (equal (abs (acet-geom-vector-d-angle
(ACET-GEOM-UNIT-VECTOR p1 origpo)
(ACET-GEOM-UNIT-VECTOR origpo p2)
)
)
(/ pi 2)
0.01
)
(cond ((/= origpo p1)
(setq ucsObjtem (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p1)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
((= origpo p1)
(setq ucsObjtem (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
)
)
(vla-delete LineOBJtemp)
(vla-put-ActiveUCS doc ucsObjtem)
(setq pUCS (trans p 0 1)
p1UCS (trans p1 0 1)
p2UCS (trans p2 0 1)
cent (acet-geom-arc-center pUCS p1UCS p2UCS)
)
(if cent
(setq R (distance cent p2UCS))
)
(setq tkc 0)
(foreach pt lst0
(setq ptUCS (trans pt 0 1)
kc1 (caddr ptUCS)
kc2 (- (sqrt (- (expt (distance ptUCS cent) 2) (expt kc1 2)))
R
)
kc3^2 (+ (expt kc2 2) (expt kc1 2))
)
(setq tkc (+ tkc kc3^2))
)
(setq
lscir (append lscir
(list (list tkc p p1 p2 origpo R cent))
)
)

)
)
)
(setq lscir (vl-sort lscir '(lambda (x y) (< (car x) (car y))))
mau (car lscir)
)
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc (/ p p1 p2 origpo R cent ucsObj
pUCS p1UCS p2UCS LstLWP LWP nor obcir
tg
)
;;; (alert
;;; (strcat
;;; "\n Tong cac binh phuong khoang cach tu cac diem toi vong tron tim duoc la: "
;;; (rtos (car mau) 2 4)
;;; )
;;; )
(acet-ucs-cmd (list "w"))
(setq p (nth 1 mau)
p1 (nth 2 mau)
p2 (nth 3 mau)
origpo (nth 4 mau)
R (nth 5 mau)
cent (nth 6 mau)
)
(if (equal (abs (acet-geom-vector-d-angle
(ACET-GEOM-UNIT-VECTOR p1 origpo)
(ACET-GEOM-UNIT-VECTOR origpo p2)
)
)
(/ pi 2)
0.01
)
(cond ((/= origpo p1)
(setq ucsObj (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p1)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
((= origpo p1)
(setq ucsObj (vla-add ucs_all
(vlax-3d-point origpo)
(vlax-3d-point p)
(vlax-3d-point p2)
"UCSthiep"
)
)
)
)
)
(vla-put-ActiveUCS doc ucsObj)
(setq pUCS (trans p 0 1)
p1UCS (trans p1 0 1)
p2UCS (trans p2 0 1)
)
(setq LstLWP (list (car pUCS)
(cadr pUCS)
(car p1UCS)
(cadr p1UCS)
(car p2UCS)
(cadr p2UCS)
)
LWP (addLWP LstLWP mspace)
nor (vla-get-Normal LWP)
obcir (vla-addcircle mspace (vlax-3d-point (trans cent 1 0)) R)
)
(vla-put-Normal obcir nor)
(vla-put-color obcir 4)
(vla-delete LWP)
(setvar "UCSICON" 1)
(setvar "osmode" oldos)
(setvar "cecolor" olc)
(command "undo" "e")
(acet-ucs-cmd '("w"))
(setq tg (getvar "date"))
(alert (strcat "Tông thoi gian chay lisp là :"
(rtos (- (* 86400.0 (- tg (fix tg))) Now))
" giây."
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Chào Duyminh86, cái gọi là điểm dạng chữ thập (+) hoặc điểm dạng hình cầu như bạn nói thì điểm này do đối tượng gì tạo ra: - 2 line cắt nhau? dạng TEXT?, điểm là tâm của hình cầu?... bạn nói rõ thêm nhé.
Chúc các bạn vui trong những ngày cuối năm!



chào bạn,

Lisp của bạn rất tuyệt, thuật toán rất OK, bạn đã rất khéo khi tính tổng bình phương khoảng cách từ các điểm tới đường tròn.

Điểm như mình nói bên trên là dạng giao của hay đường thẳng hoặc là tâm của mặt cầu bạn à, nếu nhận dạng được cả 3 dạng thì tốt nhất (dạng Point, dạng giao của 2 đường thẳng, dạng tâm của mặt cầu)

Bạn giúp mình nhé, mình chưa thêm được cái nhận dạng điểm này.

Chúc vui.
  • 0

#59 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 17 January 2011 - 04:56 PM

* Lisp của DuongTrungHuy:
- chạy rất rất chậm mặc dù Thiep thử chỉ khoảng 30 điểm.
- cái đường tròn do lisp của DuongTrungHuy tạo ra chuẩn hơn lisp của Thanhbinh.
- bạn đã rất khéo tạo điều kiện để sử dụng hàm ACET-GEOM-ARC-CENTER, bằng cách dùng dòng lệnh (command "UCS" 3 d1 d2 d3) và (Cal "w2u(d1)")... tuy nhiên cả bạn và Thanhbinh có sai sót khi khi không xét đến trường hợp có 3 điểm thẳng hàng, khi đó hàm ACET-GEOM-ARC-CENTER trả về nil, khi đó 2 bác phải dùng hàm: if tamO (hay O)
Một vài dòng suy nghĩ, chúc 2 bác khoẻ.

ô :)
Bạn Thiep cẩn thận ghê. Thật ra Mình mới đánh cho nó rả bài toán ra thôi, sau khi có kết quả thì ngồi khà khà và bắt đầu rào giậu chương trình cho kín kẻ như Bạn nói. Cũng là vui thôi Bạn góp ý vậy là tốt đó. Nhưng người lập trình thì vậy đó nghĩ chẻ sợi tóc ra làm tư cho chương trình được bao quát Bạn nhỉ, trong thực tế nếu gieo ngẫu nhiên thì cũng khó mà được 3 điểm thẳng hàng Bạn nhỉ...
Vui thôi! Cám ơn Bạn đã góp ý.
Vì Bạn không up 1 mẫu thử lên để Mình test thử xem chương trình có đạt không?Mình chỉ tưởng tưởng ra 1 số liệu để thử nghiệm chương trình.
  • 0