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

[NguyenNdait 5]

Không có chi đâu bác Bình.

Em có ý kiến như thế này để cải thiện tốc độ của Lisp. Ta hạn chế việc vòng lặp tìm biến tkc (Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la) và đồng thời hạn chế được số phần tử trong tâp lscir

Bác xây dựng thử nhé :

 

1. Nếu đường tròn mà Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la: 0 thì đường tròn đó là duy nhất

 

2. Tìm cách Xác định khoảng cách giữa 2 điểm lớn nhất gọi là Dmax. Đường tròn tìm được là đường tròn có bán kính không được lớn hơn Dmax/2.

 

=> Do đó khi mà bác vẽ đường tròn thì xác định luôn bán kính R của nó. Xem bán kính R có bé hơn Dmax/2 không?

Nếu R<= Dmax/2 thì giữ lại để xác định tổng khoảng cách bình phương và làm công việc tiếp theo.....

Nếu R> Dmax/2 thì xóa luôn đường tròn và vì thế ta không xác định biến tkc chẳng đưa vào tập lscir để tăng tốc độ của Lisp

 

3. Nếu 3 điểm thẳng hàng thì không thể nào xây dựng được đường tròn nào cả. Nếu 3 điểm thẳng hàng thì Lisp của bác chạy sai vì bác chưa xét đến trường hợp này

 

Chuúc bác vui

 

Thật ra vấn đề làm cho lsp chậm chạp và ì ạch nhất đó chính là việc gọi các hàm command của CAD.

Để tăng tốc độ của chương trình lsp cần hạn chế việc gọi lại các hàm command của CAD, thay vào đó là entmake các đối tượng muốn tạo.

TB : mà sao không thấy chủ topic đâu cả vậy ta ?

[phamthanhbinh 3.146]

Không có chi đâu bác Bình.

Em có ý kiến như thế này để cải thiện tốc độ của Lisp. Ta hạn chế việc vòng lặp tìm biến tkc (Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la) và đồng thời hạn chế được số phần tử trong tâp lscir

Bác xây dựng thử nhé :

 

1. Nếu đường tròn mà Tong binh phuong khoang cach tu cac diem toi vong tron tim duoc la: 0 thì đường tròn đó là duy nhất

 

2. Tìm cách Xác định khoảng cách giữa 2 điểm lớn nhất gọi là Dmax. Đường tròn tìm được là đường tròn có bán kính không được lớn hơn Dmax/2.

 

=> Do đó khi mà bác vẽ đường tròn thì xác định luôn bán kính R của nó. Xem bán kính R có bé hơn Dmax/2 không?

Nếu R

Nếu R> Dmax/2 thì xóa luôn đường tròn và vì thế ta không xác định biến tkc chẳng đưa vào tập lscir để tăng tốc độ của Lisp

 

3. Nếu 3 điểm thẳng hàng thì không thể nào xây dựng được đường tròn nào cả. Nếu 3 điểm thẳng hàng thì Lisp của bác chạy sai vì bác chưa xét đến trường hợp này

 

Chuúc bác vui

Chào bác Tue_NV,

Rất cám ơn bác đã góp ý.

Ý 1 và ý 3 của bác mình đã bổ sung được vào lisp và có thể nói là khá yên tâm.

Tuy nhiên ở ý 2, việc khống chế giá trị của bán kính vòng tròn phải nhỏ hơn Dmax/2 theo mình là chưa hợp lý lắm vì thực tế với một tam giác đều hay ngũ giác đều thì bán kính vòng tròn ngoại tiếp của nó lớn hơn 1/2 cái đường chéo của nó bác ạ, (với tam giác đều thì là cạnh). Vì thế theo mình nghĩ thì việc khống chế bán kính này nên lấy ở giá trị (Dmax / (sqrt 2)) có nhẽ sẽ hợp lý hơn bác ạ.

Vì thế mình đã bổ sung thành cái lisp như sau, rất mong các bác góp ý để hoàn thiện nó.

(defun c:nst ( / olc lscir ssp ssp1 p1 p2 lst lst1 lst2 p cir tkc pt pc kc mau d1 d2 d3 ra dm 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"))))
;;;;;;;;(setq p1 (car (acet-geom-ss-extents ssp 0))
      ;;;;;;;; p2 (cadr (acet-geom-ss-extents ssp 0))
;;;;;;;:undecided:
(locpoint ssp)
;;;;;;;;(setq ssp1 (ssget "c" p1 p2 (list (cons 0 "point"))))
;;;;;;;;(setq lst (acet-ss-to-list ssp1) ) 
(setq lst0 lst) 
(setq dm (dmax lst0)) 
(foreach e lst
     (setq lst1 (vl-remove e lst)  
             lst (vl-remove e lst)            
             p (cdr (assoc 10 (entget e)))              
     )
     (foreach e1 lst1      
           (setq lst2 (vl-remove e1 lst1) 
                   lst1 (vl-remove e1 lst1)                   
                   p1 (cdr (assoc 10 (entget e1))) 
                   ;;;;;;g1 (angle p p1)
                   d1 (distance p p1)
           )
           (foreach e2 lst2         
                  (setq p2 (cdr (assoc 10 (entget e2))))
                  (setvar "cecolor" "3")
                  (setq ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;g2 (angle p1 p2)
                          d2 (distance p1 p2)
                          d3 (distance p2 p)
                   )
                  (if (and (                       (command "circle" "3p" p p1 p2 )
                  )
                  (setq ent (entlast))
                  (setq cir (vlax-ename->vla-object ent))
                  (setq tkc 0)
                  (setq ra (cdr (assoc 40 (entget ent))))
                  (if (                   (progn
                  (foreach e lst0
                         (setq pt (cdr (assoc 10 (entget e))))
                         (setq pc (vlax-curve-getClosestPointTo cir pt ))
                         (setq kc (distance pt pc))
                         (setq tkc (+ tkc (expt kc 2)))

                  )
                  (if (= tkc 0)
                      (progn
                           (setq mau (list tkc ent))
                           (ketthuc)
                      )
                      (setq lscir (append lscir (list (list tkc ent)))) 
                  )
                  ) 
                  (command "erase" ent "")
                  )                              
           )          
     ) 
)
(setq lscir (vl-sort lscir '(lambda (x 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 2)))
(setq po (cdr (assoc 10 (entget (cadr mau))))
       R (cdr (assoc 40 (entget (cadr mau))))
)
(command "point" po "")
(alert (strcat "\n Vong tron tim duoc co toa do tam la:" "\n x = " (rtos (car po) 2 4) 
              "\n y =  " (rtos (cadr po) 2 4) "\n z =  " (rtos (caddr po) 2 4)
                  "\n Ban kinh la " (rtos R 2 4) ))
(foreach cir lscir
         (if (/= (cadr cir) (cadr mau))
            (command "erase" (cadr cir) "")
         )
)
(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 (               (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 "")
              )
              (setq i (1+ i))
        )
    )
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
Xac dinh khoang cach lon nhat giua cac diem trong danh sach ename cua cac diem duoc chon

(defun dmax (lstp / lstp1 lstp0 lsdc p p1 d )
(setq lstp0 lstp)
(setq lsdc (list))
(foreach e lstp
      (setq lstp1 (vl-remove e lstp)
              lstp (vl-remove e lstp)
              p (cdr (assoc 10 (entget e)))
      ) 
      (foreach e1 lstp1
            (setq p1 (cdr (assoc 10 (entget e1)))
                    d (distance p p1)
                    lsdc (append lsdc (list d)) 
            )
      )
)
(setq lsdc (vl-sort lsdc '(lambda (x y) (>= x y))))
(setq dma (car lsdc))
dma
)                 

 

@Bác NguyenNdait,

Việc dùng hàm entmake trong trường hợp này sẽ phải lập công thức tính toán tọa độ tâm và bán kính của vòng tròn qua ba điểm cho trước. Về Lý thuyết hoàn toàn khả thi song thực tế ngồi mò mẫm lại cái đám công thức phổ thông này cũng hơi đau đầu bác ạ vả cũng khá dài dòng. Việc này mong bác thư thư cho một chút để mình còn mò mẫm chứ chưa thử ngay được bác ạ.

[DuongTrungHuy 128]

Việc dùng hàm entmake trong trường hợp này sẽ phải lập công thức tính toán tọa độ tâm và bán kính của vòng tròn qua ba điểm cho trước. Về Lý thuyết hoàn toàn khả thi song thực tế ngồi mò mẫm lại cái đám công thức phổ thông này cũng hơi đau đầu bác ạ vả cũng khá dài dòng. Việc này mong bác thư thư cho một chút để mình còn mò mẫm chứ chưa thử ngay được bác ạ.

Để tìm vòng tròn qua 1 danh sách 3 điểm Bạn dùng thử đoạn sau:

 

(defun tamO_nt(ds3diem / xA yA xB yB xC yC)

(setq xA (car (nth 0 ds3diem)) yA (cadr (nth 0 ds3diem))

xB (car (nth 1 ds3diem)) yB (cadr (nth 1 ds3diem))

xC (car (nth 2 ds3diem)) yC (cadr (nth 2 ds3diem))

)

(Cond

((< (abs(- xA xB)) 0.0000001)(setq xx xA xA xC xC xx xx yA yA yC yC xx))

((< (abs(- xA xC)) 0.0000001)(setq xx xA xA xB xB xx xx yA yA yB yB xx))

)

(setq so1 (/ (+ (- (* xB xB)(* xA xA)) (- (* yB yB)(* yA yA))) (- xB xA))

so2 (/ (+ (- (* xC xC)(* xA xA)) (- (* yC yC)(* yA yA))) (- xC xA))

so3 (/ (- yB yA) (- xB xA))

so4 (/ (- yC yA) (- xC xA))

tamO_y (/ (- so1 so2)(- so3 so4) 2.0)

tamO_x (- (/ so1 2.0) (* tamO_y so3))

tamO (list tamo_x tamo_y)

bkR (distance tamO (list xC yC))

)

)

 

 

Bạn viết thêm đoạn loại bỏ khi 3 điểm đó thẳng hàng.Giá trị trả về là điểm tamO và BkR

[phamthanhbinh 3.146]

Để tìm vòng tròn qua 1 danh sách 3 điểm Bạn dùng thử đoạn sau:

 

(defun tamO_nt(ds3diem / xA yA xB yB xC yC)

(setq xA (car (nth 0 ds3diem)) yA (cadr (nth 0 ds3diem))

xB (car (nth 1 ds3diem)) yB (cadr (nth 1 ds3diem))

xC (car (nth 2 ds3diem)) yC (cadr (nth 2 ds3diem))

)

(Cond

((

((

)

(setq so1 (/ (+ (- (* xB xB)(* xA xA)) (- (* yB yB)(* yA yA))) (- xB xA))

so2 (/ (+ (- (* xC xC)(* xA xA)) (- (* yC yC)(* yA yA))) (- xC xA))

so3 (/ (- yB yA) (- xB xA))

so4 (/ (- yC yA) (- xC xA))

tamO_y (/ (- so1 so2)(- so3 so4) 2.0)

tamO_x (- (/ so1 2.0) (* tamO_y so3))

tamO (list tamo_x tamo_y)

bkR (distance tamO (list xC yC))

)

)

Bạn viết thêm đoạn loại bỏ khi 3 điểm đó thẳng hàng.Giá trị trả về là điểm tamO và BkR

Chào các bác,

Đây là cái lisp mình sửa lại bỏ các hàm gọi command của CAD và thay bằng các hàm trong lisp. Mình sử dụng sự trợ giúp của bác Dương Trung Huy để lấy tâm và bán kính của vòng tròn đi qua ba điểm không thẳng hàng

(defun c:nst ( / olc lscir ssp ssp1 p1 p2 lst lst1 lst2 p cir tkc pt pc kc mau d1 d2 d3 ra dm 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"))))
;;;;;;;;(setq p1 (car (acet-geom-ss-extents ssp 0))
      ;;;;;;;; p2 (cadr (acet-geom-ss-extents ssp 0))
;;;;;;;:undecided:
(locpoint ssp)
;;;;;;;;(setq ssp1 (ssget "c" p1 p2 (list (cons 0 "point"))))
;;;;;;;;(setq lst (acet-ss-to-list ssp1) ) 
(setq lst0 lst) 
(setq dm (dmax lst0)) 
(setvar "cecolor" "3")
(foreach e lst
     (setq lst1 (vl-remove e lst)  
             lst (vl-remove e lst)            
             p (cdr (assoc 10 (entget e)))              
     )
     (foreach e1 lst1      
           (setq lst2 (vl-remove e1 lst1) 
                   lst1 (vl-remove e1 lst1)                   
                   p1 (cdr (assoc 10 (entget e1))) 
                   d1 (distance p p1)
           )
           (foreach e2 lst2         
                  (setq p2 (cdr (assoc 10 (entget e2))))
                  (setq d2 (distance p1 p2)
                          d3 (distance p2 p)
                   )
                  (if (and (                       ;;;;;;;;(command "circle" "3p" p p1 p2 )
                      (progn
                            (setq lst3d (list p p1 p2))
                            (tamo_nt lst3d )
                            (entmake (list (cons 0 "circle") (cons 10 tamo) (cons 40 bkR)))
                      )
                  )
                  (setq ent (entlast))
                  (setq cir (vlax-ename->vla-object ent))
                  (setq tkc 0)
                  (setq ra (cdr (assoc 40 (entget ent))))
                  (if (                   (progn
                  (foreach e lst0
                         (setq pt (cdr (assoc 10 (entget e))))
                         (setq pc (vlax-curve-getClosestPointTo cir pt ))
                         (setq kc (distance pt pc))
                         (setq tkc (+ tkc (expt kc 2)))

                  )
                  (if (= tkc 0)
                      (progn
                           (setq mau (list tkc ent))
                           (ketthuc)
                      )
                      (setq lscir (append lscir (list (list tkc ent)))) 
                  )
                  ) 
                  ;;;;;;(command "erase" ent "")
                  (entdel ent)
                  )                              
           )          
     ) 
)
(setq lscir (vl-sort lscir '(lambda (x 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)))
(setq po (cdr (assoc 10 (entget (cadr mau))))
       R (cdr (assoc 40 (entget (cadr mau))))
)
(command "point" po "")
(alert (strcat "\n Vong tron tim duoc co toa do tam la:" "\n x = " (rtos (car po) 2 4) 
              "\n y =  " (rtos (cadr po) 2 4) "\n z =  " (rtos (caddr po) 2 4)
                  "\n Ban kinh la " (rtos R 2 4) ))
(foreach cir lscir
         (if (/= (cadr cir) (cadr mau))
            ;;;;;;(command "erase" (cadr cir) "")
            (entdel (cadr cir))
         )
)
(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 (               (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
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
;;;;;Xac dinh khoang cach lon nhat giua cac diem trong danh sach ename cua cac diem duoc chon

(defun dmax (lstp / lstp1 lstp0 lsdc p p1 d )
(setq lstp0 lstp)
(setq lsdc (list))
(foreach e lstp
      (setq lstp1 (vl-remove e lstp)
              lstp (vl-remove e lstp)
              p (cdr (assoc 10 (entget e)))
      ) 
      (foreach e1 lstp1
            (setq p1 (cdr (assoc 10 (entget e1)))
                    d (distance p p1)
                    lsdc (append lsdc (list d)) 
            )
      )
)
(setq lsdc (vl-sort lsdc '(lambda (x y) (>= x y))))
(setq dma (car lsdc))
dma
)                 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;                    
;;;;;;Xac dinh tam va ban kinh vong tron qua 3 diem

(defun tamO_nt (ds3diem / xA yA xB yB xC yC)
(setq xA (car (nth 0 ds3diem)) yA (cadr (nth 0 ds3diem))
xB (car (nth 1 ds3diem)) yB (cadr (nth 1 ds3diem))
xC (car (nth 2 ds3diem)) yC (cadr (nth 2 ds3diem))
)
(Cond
(((()
(setq so1 (/ (+ (- (* xB xB)(* xA xA)) (- (* yB yB)(* yA yA))) (- xB xA))
so2 (/ (+ (- (* xC xC)(* xA xA)) (- (* yC yC)(* yA yA))) (- xC xA))
so3 (/ (- yB yA) (- xB xA))
so4 (/ (- yC yA) (- xC xA))
tamO_y (/ (- so1 so2)(- so3 so4) 2.0)
tamO_x (- (/ so1 2.0) (* tamO_y so3))
tamO (list tamo_x tamo_y)
bkR (distance tamO (list xC yC))
)
)

 

Kết quả mình có vài nhận xét như sau:

1/- Quả nhiên là lisp chạy nhanh hơn hẳn về tốc độ.

2/- Khi số lượng đối tượng đủ lớn, lisp chạy bị lỗi xóa không hết các vòng tròn cần xóa bởi lệnh (entdel (cadr cir)) thay vì (command "erase" (cadr cir) "")

3/- Khi chạy lisp các vòng tròn được tạo bởi hàm enmake xuất hiện chỉ sau khi có hàm thông báo alert, khác với khi dùng lệnh command "circle" của CAD.

Khi đó các vòng tròn xuất hiện lần lượt trứớc khi bảng thông báo alert xuất hiện. Điều này chừng nào đó gây khó hiểu cho người dùng.

4/- Kết luận của mình, có nhẽ chậm mà chắc, cứ nên xài thằng command của CAD có nhẽ nó ổn định và theo đúng ý đồ của người viết hơn các bác nhể.

5/- Các bác có thể giải thích được vì sao có những hiện tượng như vầy hay không, phải chăng các hàm lisp nó chạy nhanh quá nên bỏ sót lỗi????

Chúc các bác luôn vui.

[Tue_NV 3.912]

1 .Để tìm vòng tròn qua 1 danh sách 3 điểm Bạn dùng thử đoạn sau:

 

(defun tamO_nt(ds3diem / xA yA xB yB xC yC)

(setq xA (car (nth 0 ds3diem)) yA (cadr (nth 0 ds3diem))

xB (car (nth 1 ds3diem)) yB (cadr (nth 1 ds3diem))

xC (car (nth 2 ds3diem)) yC (cadr (nth 2 ds3diem))

)

(Cond

((

((

)

(setq so1 (/ (+ (- (* xB xB)(* xA xA)) (- (* yB yB)(* yA yA))) (- xB xA))

so2 (/ (+ (- (* xC xC)(* xA xA)) (- (* yC yC)(* yA yA))) (- xC xA))

so3 (/ (- yB yA) (- xB xA))

so4 (/ (- yC yA) (- xC xA))

tamO_y (/ (- so1 so2)(- so3 so4) 2.0)

tamO_x (- (/ so1 2.0) (* tamO_y so3))

tamO (list tamo_x tamo_y)

bkR (distance tamO (list xC yC))

)

)

2 .Bạn viết thêm đoạn loại bỏ khi 3 điểm đó thẳng hàng.Giá trị trả về là điểm tamO và BkR

Ý 1 và ý 2 của Bác DuongTrungHuy có thể sử dụng qua code sau

Lisp tìm tâm và bán kính đường tròn qua 3 điểm không thẳng hàng. Kiểm tra luôn 3 điểm thẳng hàng thì không xây dựng được đường tròn (không tìm được tâm và bán kính

(defun CirC(A D C / M1 M2 M11 M21)
(setq M1 (acet-geom-midpoint A D))
(setq M2 (acet-geom-midpoint C D))
(setq M11 (polar M1 (+ (angle A D) (/ pi 2)) 100))
(setq M21 (polar M2 (+ (angle C D) (/ pi 2)) 100))
(if (setq tam (inters M1 M11 M2 M21 nil))
(setq R (distance tam A))
(alert "3 diem thang hang")
)
)

Tâm của đường tròn đi qua 3 điểm là giao điểm của 3 đường trung trực (của 3 cạnh). Ta chỉ cần tìm giao điểm của 2 đường trung trực là đủ, đường trung trực còn lại tất yếu sẽ đi qua tâm. Nếu 2 đường trung trực song song (không tìm được giao điểm) -> Chứng tỏ 3 điểm thẳng hàng. Ý tưởng đã được Tue_NV trình bày trên code trên

 

@Bác PhamThanhBinh : Bác có thể sử dụng code của Tue_NV để kiểm tra 3 điểm thẳng hàng và đồng thời tìm tâm và bán kính của đường tròn đi qua 3 điểm không thẳng hàng luôn

Em dạo này bận quá. Khi rãnh để em đọc code của bác và chạy thử mới góp ý được

Chúc bác sức khoẻ

[phamthanhbinh 3.146]

Ý 1 và ý 2 của Bác DuongTrungHuy có thể sử dụng qua code sau

Lisp tìm tâm và bán kính đường tròn qua 3 điểm không thẳng hàng. Kiểm tra luôn 3 điểm thẳng hàng thì không xây dựng được đường tròn (không tìm được tâm và bán kính

(defun CirC(A D C / M1 M2 M11 M21)
(setq M1 (acet-geom-midpoint A D))
(setq M2 (acet-geom-midpoint C D))
(setq M11 (polar M1 (+ (angle A D) (/ pi 2)) 100))
(setq M21 (polar M2 (+ (angle C D) (/ pi 2)) 100))
(if (setq tam (inters M1 M11 M2 M21 nil))
(setq R (distance tam A))
(alert "3 diem thang hang")
)
)

Tâm của đường tròn đi qua 3 điểm là giao điểm của 3 đường trung trực (của 3 cạnh). Ta chỉ cần tìm giao điểm của 2 đường trung trực là đủ, đường trung trực còn lại tất yếu sẽ đi qua tâm. Nếu 2 đường trung trực song song (không tìm được giao điểm) -> Chứng tỏ 3 điểm thẳng hàng. Ý tưởng đã được Tue_NV trình bày trên code trên

 

@Bác PhamThanhBinh : Bác có thể sử dụng code của Tue_NV để kiểm tra 3 điểm thẳng hàng và đồng thời tìm tâm và bán kính của đường tròn đi qua 3 điểm không thẳng hàng luôn

Em dạo này bận quá. Khi rãnh để em đọc code của bác và chạy thử mới góp ý được

Chúc bác sức khoẻ

Chào bác Tue_NV,

Mình đã thay cái lisp của bác vào vị trí cái lisp của bác Dương Trung Huy, song kết quả cũng tương tự như bài post trước bác ạ. Nghĩa là khi tăng số điểm lên một giá trị nào đó thì cả hai đều xuất hiện hiện tượng xóa không hết các vòng tròn không được chọn. Khi thay hàm (command "erase" (cadr cir)) vào hàm (entdel (cadr cir)) thì lisp chạy chậm lại nhưng không bỏ sót nữa bác ạ.

Một lỗi nữa là không rõ tại sao mình đã loại trường hợp 3 điểm thẳng hàng bằng hàm (if (and (

Vậy mà khi chạy lisp thỉnh thoảng vẫn xuất hiện thông bào " 3 điểm thẳng hàng" . Tức là việc loại trừ của mình chưa triệt để.

Phải chăng đó là nhựơc điểm của lisp khi lấy khoảng cách bằng hàm (distance .... ) không được chính xác hả bác????

Chúc bác khỏe và thuận lợi trong công việc để rảnh thời gian, giúp đỡ mọi người được nhiều hơn.

[duyminh86 1]

cảm ơn bác phamthanhbinh chương trình Lisp này của bác rất tuyệt, nhưng với phương pháp này chắc sẽ khó để làm trên 3D. Bác có phương pháp nào mà có thể làm trên 3D được ko.

Mong bác và mọi người ngâm cứu giúp em thực hiện trên 3D với nhé, vì công việc nó đòi hỏi trên 3D mà

 

em cám ơn các bác rất nhiều, các bác thật nhiệt tình, chúc cho cadviet phát triển mạnh

[phamthanhbinh 3.146]

cảm ơn bác phamthanhbinh chương trình Lisp này của bác rất tuyệt, nhưng với phương pháp này chắc sẽ khó để làm trên 3D. Bác có phương pháp nào mà có thể làm trên 3D được ko.

Mong bác và mọi người ngâm cứu giúp em thực hiện trên 3D với nhé, vì công việc nó đòi hỏi trên 3D mà

 

em cám ơn các bác rất nhiều, các bác thật nhiệt tình, chúc cho cadviet phát triển mạnh

Hề hề hề,

Thực ra thì với cách tổ hợp 3 điểm này thì với cả 3D nó cũng như rứa. Chỉ có điều các mặt phẳng tạo bởi 3 điểm này không phải lúc nào cũng thỏa mãn là nghiêng với mặt phẳng vuông góc đường tâm trụ một góc nằm trong giới hạn như bạn yêu cầu mà thôi. Như vậy có nhẽ phải tính đến việc xét góc của mặt phẳng tạo bởi 3 điểm với mặt phảng cho trước bạn ạ.

Chắc chắn các bác trên diễn đàn sẽ có võ trị được nó, bạn yên tâm chờ đợi nhé....

Hề hề hề.

[NguyenNdait 5]

Hề hề hề,

Thực ra thì với cách tổ hợp 3 điểm này thì với cả 3D nó cũng như rứa. Chỉ có điều các mặt phẳng tạo bởi 3 điểm này không phải lúc nào cũng thỏa mãn là nghiêng với mặt phẳng vuông góc đường tâm trụ một góc nằm trong giới hạn như bạn yêu cầu mà thôi. Như vậy có nhẽ phải tính đến việc xét góc của mặt phẳng tạo bởi 3 điểm với mặt phảng cho trước bạn ạ.

Chắc chắn các bác trên diễn đàn sẽ có võ trị được nó, bạn yên tâm chờ đợi nhé....

Hề hề hề.

Mình viết ctrình này như sau :

;; free lisp from cadviet.com
(defun chap3_lstp (lst / lst lst0 lst1 lst2 lstc p)
  (setq lstc '() lst2 '() lst1 '())
  (setq lst0 lst)
(foreach e lst
      (setq lst1 (vl-remove e lst) lst (vl-remove e lst) p e)              
      (foreach e1 lst1      
            (setq lst2 (vl-remove e1 lst1) lst1 (vl-remove e1 lst1) p1 e1)                   
            (foreach e2 lst2         
                   (setq p2 e2)
                   (setq lstc (append (list (list p p1 p2)) lstc)))))
  lstc
  );end chap3
;-------------------------------------------
(defun c:noisuy ()
  (setq ssp (ssget (list (cons 0 "point"))))
  (setq i 0 n (sslength ssp) lstpt '())
  (while (< i n)
    (setq p (cdr (assoc 10 (entget (ssname ssp i)))))
    (if (not (member p lstpt))
      (setq lstpt (append lstpt (list p)))
      (setq ssp (vl-remove e ssp)));if
    (setq i (1+ i)));while
  (setq lpoint (chap3_lstp lstpt))
  (setq i 0 lcen '() lsum '() lrad '())
  (repeat (length lpoint)
    (setq dtron (nth i lpoint))
    (setq p1 (nth 0 dtron) p2 (nth 1 dtron) p3 (nth 2 dtron))
    (setq A12 (angle p1 p2) A13 (angle p1 p3))
    (if (or (equal A12 A13 0.000001) (equal A12 (/ A13 pi) 0.000001) (equal (/ A12 pi) A13 0.000001))
      (setq i (1+ i)); 3 diem thang hang
      (progn
(setq pt2 (mapcar '- p2 p1) pt3 (mapcar '- p3 p1))
        (setq x2 (nth 0 pt2) y2 (nth 1 pt2) x3 (nth 0 pt3) y3 (nth 1 pt3))
        (setq detA (- (* x2 y3) (* y2 x3)) m (* -0.5 (+ (expt x2 2) (expt y2 2))) n (* -0.5 (+ (expt x3 2) (expt y3 2))))
        (setq a (/ (- (* m y3) (* n y2)) detA) b (/ (- (* n x2) (* m x3)) detA))
(setq cen (mapcar '+ p1 (list (- a) (- b) 0.0)))
(setq radius (distance cen p1) sumdis 0.0)
(foreach point lstpt
  (setq p point)
  (setq dis (- (distance cen p) radius))
  (setq sumdis (+ sumdis (expt dis 2)))
  );foreach
(setq lcen (append lcen (list cen)) lsum (append lsum (list sumdis))  lrad (append lrad (list radius)) i (1+ i))
);progn
      );if
    );repeat
 (setq k (nth 0 (vl-sort-i lsum '<)))
 (entmake (list (cons 0 "circle") (cons 10 (nth k lcen)) (cons 40 (nth k lrad))))
  );defun
;------------------------------------------

Tốc độ rất đạt. Nên có thể dùng trong 3D đc với đk phải chia tập hợp n điểm ban đầu thành nhiều tập con chỉ gồm những điểm đồng phẳng.

(P1 P2 . . . Pn) -> ((Pni Pnk ...) (...)) Trong đó (Pn Pnk ... ) là tập hợp con chỉ gồm các điểm có cùng độ cao z

[NguyenNdait 5]

Chào cả nhà !

Nãy giờ rảnh mình test lại các chương trình của mình cũng như của PTBinh với số lượng điểm khoảng 100 điểm.

Và thật sự thấy đều lâu kinh khủng do có quá nhiều phần tử.

Vậy điều cần thiết là phải có tiêu chí để loại bớt số phần tử trong lúc lấy tổ hợp.

Chúc mọi người ngày cuối tuần vui vẻ.

[phamthanhbinh 3.146]

Chào cả nhà !

Nãy giờ rảnh mình test lại các chương trình của mình cũng như của PTBinh với số lượng điểm khoảng 100 điểm.

Và thật sự thấy đều lâu kinh khủng do có quá nhiều phần tử.

Vậy điều cần thiết là phải có tiêu chí để loại bớt số phần tử trong lúc lấy tổ hợp.

Chúc mọi người ngày cuối tuần vui vẻ.

Chào bác NguyenNdait,

Quả thật là việc cơ bản phải giải quyết là thuật toán loại bớt các điểm để giảm thiểu số điểm cần xét. Tuy nhiên do chưa có tiêu chí để loại nên hiện tại mới chỉ là loại các điểm trùng nhau và các điểm thẳng hàng.

Nếu có thể đưa ra thêm các tiếu chí loại điểm nữa thì tốt quá bác ạ.

Mình làm thử bài toán của bạn duyminh86 về xác định mặt phẳng nghiêng.

Hướng giải là

1/- Chọn các nhóm 3 điểm không thẳng hàng.

2/- lập phương trình mặt phẳng qua 3 diểm đó.

3/- Loại bỏ các mặt phẳng có góc tạo với mặt phẳng z=0 một góc nghiêng > 25 độ. (vì chưa rõ cái mặt phẳng vuông góc với đường tâm trụ của bạn duyminh nằm theo kiểu gì nên tạm chọn là hình trụ thẳng đứng, khi cần thiết có thể phải xác định góc giữa mặt phẳng mới tạo với mặt phẳng này)

4/- Lấy bình phương tổng khoảng cách từ các điểm trong tập hợp tới mặt phẳng đó.

5/- Chọn mặt phẳng có giá trị tổng bình phương các khoảng cách là nhỏ nhất

6/- Xác định 3 điểm đó và phương trình mặt phẳng qua 3 điểm này

 

Kết quả được lisp như sau:

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

(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 (                              (                       (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)))
                           )
                      )
                  )
                  (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 kc (abs (/ (+ (* A x0) (* B y0) (* C z0) D) 
                                                (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))
                         (setq tkc (+ tkc (expt kc 2)))                              
                  )
                  (if (= tkc 0)
                      (progn
                           (setq mau (list tkc p p1 p2 A B C D))
                           (ketthuc)
                      )
                      (setq lscir (append lscir (list (list tkc p p1 p2 A B C D)))) 
                  )
                  ) 
                  )                              
           )          
     ) 
)
(setq lscir (vl-sort lscir '(lambda (x y) ((setq mau (car lscir))
(ketthuc)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ketthuc ()
(alert (strcat  "\n Tong binh phuong khoang cach tu cac diem toi mat phang tim duoc la:  " 
                   (rtos (car mau) 2 4)))

(command "point" (cadr mau) )
(command "point" (caddr mau) )
(command "point" (cadddr 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 z =  " (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 "
))

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


;;

 

Kết quả chạy thử cho thấy:

1/- Lisp này chạy nhanh hơn lisp nội suy tâm vòng tròn đi qua tập hợp điểm đồng phẳng do không cần phải dựng vòng tròn qua ba điểm.

2/- Lisp chỉ cho người dùng biết 3 điểm đã tạo ra mặt phẳng và phương trình của mặt phẳng cũng như tổng bình phương các khoảng cách từ các điểm trong tập hợp điểm được chọn tới mặt phẳng đó để người dùng tùy nghi sử dụng.

3/- Đây chưa phải là mặt phẳng tối ưu, có tổng bình phương khoảng cách từ các điểm tới nó là nhỏ nhất, song nó là tối ưu trong số các mặt phẳng đi qua 3 điểm bất kỳ không thẳng hàng của tập hợp điểm.

4/- Có thể loại bớt các mặt phẳng này bằng cách hạn chế góc nghiêng của nó so với mặt phẳng chuẩn để lisp chạy nhanh hơn.

 

Rất mong các bác dùng thử và cho ý kiến để hoàn thiện nó.

[duyminh86 1]

Hề hề hề,

Thực ra thì với cách tổ hợp 3 điểm này thì với cả 3D nó cũng như rứa. Chỉ có điều các mặt phẳng tạo bởi 3 điểm này không phải lúc nào cũng thỏa mãn là nghiêng với mặt phẳng vuông góc đường tâm trụ một góc nằm trong giới hạn như bạn yêu cầu mà thôi. Như vậy có nhẽ phải tính đến việc xét góc của mặt phẳng tạo bởi 3 điểm với mặt phảng cho trước bạn ạ.

Chắc chắn các bác trên diễn đàn sẽ có võ trị được nó, bạn yên tâm chờ đợi nhé....

Hề hề hề.

 

 

Rất cám ơn các bác phamthanhbinh, Tue_NV, NguyenNdait, DuongTrungHuy và tất cả các thành viên tham gia topic đã giúp đỡ.

 

Em quên mất ko nói với các bác là vẫn đề mà em nhờ các bác giải quyết thực ra nó chỉ có giới hạn số lượng điểm thôi các bác ạ, cùng lắm là 20 điểm thôi.

 

Thế nên vấn đề về tốc độ có lẽ ko cần tới, nhưng nó đòi hỏi phải làm trên 3D.

 

Chương trình của các bác rất tốt trên 2D nhưng khi em thử trên 3D thì ko cho ra kết quả các bác ạ. Nó sai như sau:

Ở phía bên phải em lấy các điểm trên cùng mặt phẳng thì OK, nhưng khi lấy các điểm trong không gian nghiêng như bên phải thì cho ra hình tròn sai.

 

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

 

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

[phamthanhbinh 3.146]

Rất cám ơn các bác phamthanhbinh, Tue_NV, NguyenNdait, DuongTrungHuy và tất cả các thành viên tham gia topic đã giúp đỡ.

 

Em quên mất ko nói với các bác là vẫn đề mà em nhờ các bác giải quyết thực ra nó chỉ có giới hạn số lượng điểm thôi các bác ạ, cùng lắm là 20 điểm thôi.

 

Thế nên vấn đề về tốc độ có lẽ ko cần tới, nhưng nó đòi hỏi phải làm trên 3D.

 

Chương trình của các bác rất tốt trên 2D nhưng khi em thử trên 3D thì ko cho ra kết quả các bác ạ. Nó sai như sau:

Ở phía bên phải em lấy các điểm trên cùng mặt phẳng thì OK, nhưng khi lấy các điểm trong không gian nghiêng như bên phải thì cho ra hình tròn sai.

 

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

 

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

Hề hề hề,

Cái nhà ông chủ thớt này đoảng quá. Kiểu này thì ế hàng to đấy.

Cái lisp dành cho các điểm nằm trong không gian , tức là xác định mặt phẳng nghiêng vói mặt phẳng nằm ngang một góc nhỏ hơn 25 độ (Ở đây coi như mình chọn hình trụ có trục vuông góc với mặt phẳng ngang Z=0 ) có tổng bình phương khoảng cách tới các điểm trong tập hợp chọn là nhỏ nhất, đã được mình post lên từ mấy ngày trước rồi mà ông chủ thớt không thèm ngó ngàng chi tới. Thiệt tình .......

Bạn hãy test cái lisp đó xem đã ưng ý chưa và còn cần sử chữa gì thì nói nhé. (bài post số 123968 , trước bài post cuối cùng của bạn)

Gì chứ cỡ 20 điểm thì lisp này chạy ngon , chỉ khoảng một phút là xong tất.....

Hề hề hề....

[thiep 365]

Chào bác NguyenNdait,

Quả thật là việc cơ bản phải giải quyết là thuật toán loại bớt các điểm để giảm thiểu số điểm cần xét. Tuy nhiên do chưa có tiêu chí để loại nên hiện tại mới chỉ là loại các điểm trùng nhau và các điểm thẳng hàng.

Nếu có thể đưa ra thêm các tiếu chí loại điểm nữa thì tốt quá bác ạ.

Mình làm thử bài toán của bạn duyminh86 về xác định mặt phẳng nghiêng.

Hướng giải là

1/- Chọn các nhóm 3 điểm không thẳng hàng.

2/- lập phương trình mặt phẳng qua 3 diểm đó.

3/- Loại bỏ các mặt phẳng có góc tạo với mặt phẳng z=0 một góc nghiêng > 25 độ. (vì chưa rõ cái mặt phẳng vuông góc với đường tâm trụ của bạn duyminh nằm theo kiểu gì nên tạm chọn là hình trụ thẳng đứng, khi cần thiết có thể phải xác định góc giữa mặt phẳng mới tạo với mặt phẳng này)

4/- Lấy bình phương tổng khoảng cách từ các điểm trong tập hợp tới mặt phẳng đó.

5/- Chọn mặt phẳng có giá trị tổng bình phương các khoảng cách là nhỏ nhất

6/- Xác định 3 điểm đó và phương trình mặt phẳng qua 3 điểm này

 

Kết quả được lisp như sau:

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

(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
                           [color="#FF0000"](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)))
                           )
                      )
                  )
                  (setq tkc 0)
                  (setq ra (abs (/ C (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))[/color]
                  (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 kc (abs (/ (+ (* A x0) (* B y0) (* C z0) D) 
                                                (sqrt (+ (expt A 2) (expt B 2) (expt C 2))))))
                         (setq tkc (+ tkc (expt kc 2)))                              
                  )
                  (if (= tkc 0)
                      (progn
                           (setq mau (list tkc p p1 p2 A B C D))
                           (ketthuc)
                      )
                      (setq lscir (append lscir (list (list tkc p p1 p2 A B C D)))) 
                  )
                  ) 
                  )                              
           )          
     ) 
)
(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 mat phang tim duoc la:  " 
                   (rtos (car mau) 2 4)))

(command "point" (cadr mau) )
(command "point" (caddr mau) )
(command "point" (cadddr 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 z =  " (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 "
))

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



;;

 

Kết quả chạy thử cho thấy:

1/- Lisp này chạy nhanh hơn lisp nội suy tâm vòng tròn đi qua tập hợp điểm đồng phẳng do không cần phải dựng vòng tròn qua ba điểm.

2/- Lisp chỉ cho người dùng biết 3 điểm đã tạo ra mặt phẳng và phương trình của mặt phẳng cũng như tổng bình phương các khoảng cách từ các điểm trong tập hợp điểm được chọn tới mặt phẳng đó để người dùng tùy nghi sử dụng.

3/- Đây chưa phải là mặt phẳng tối ưu, có tổng bình phương khoảng cách từ các điểm tới nó là nhỏ nhất, song nó là tối ưu trong số các mặt phẳng đi qua 3 điểm bất kỳ không thẳng hàng của tập hợp điểm.

4/- Có thể loại bớt các mặt phẳng này bằng cách hạn chế góc nghiêng của nó so với mặt phẳng chuẩn để lisp chạy nhanh hơn.

Rất mong các bác dùng thử và cho ý kiến để hoàn thiện nó.

Chào bác Bình, sau khi đọc lisp của bác, Thiep có 1 số thắc mắc và nhận xét sau:

- Lisp của bác có mấy công thức xác định A, B, C, D, Thiep hiểu là các thông số của pT mặt phẳng đi qua 3 điểm p, p1, p2: Ax+By+Cz+D=0, không biết có đúng không nữa.

- Tuy nhiên, từ đây, bác xác định: ra, có phải là bán kính của đường tròn đi qua 3 điểm trên không? Nếu đúng thì sao nó không phụ thuộc vào thông số D? Và tại sao bác đặt điều kiện: ra>=0.9?

- Bác xác định kc, theo Thiep thì đây chỉ là khoảng cách từ điểm P0 đến mặt phẳng Ax+By+Cz+D=0, chứ chưa phải là khoảng cách ngắn nhất từ P0 đến đường tròn đi qua 3 điểm p1, p2, p3. Và kc luôn luôn là số dương nên không cần thêm hàm abs.

- Bác dùng hàm này thay cho hàm locpoint của bác:

(ACET-LIST-REMOVE-DUPLICATEs lst nil): Hàm này sẽ loại bỏ hết các phần tử trùng lập, hoặc gần trùng trong 1 list, trong đó: lst là 1 list, các phần tử có thể là tọa độ của điểm, có thể là string ..., nil là sai số so sánh.

Thân chào bác.

[phamthanhbinh 3.146]

Chào bác Bình, sau khi đọc lisp của bác, Thiep có 1 số thắc mắc và nhận xét sau:

- Lisp của bác có mấy công thức xác định A, B, C, D, Thiep hiểu là các thông số của pT mặt phẳng đi qua 3 điểm p, p1, p2: Ax+By+Cz+D=0, không biết có đúng không nữa.

- Tuy nhiên, từ đây, bác xác định: ra, có phải là bán kính của đường tròn đi qua 3 điểm trên không? Nếu đúng thì sao nó không phụ thuộc vào thông số D? Và tại sao bác đặt điều kiện: ra>=0.9?

- Bác xác định kc, theo Thiep thì đây chỉ là khoảng cách từ điểm P0 đến mặt phẳng Ax+By+Cz+D=0, chứ chưa phải là khoảng cách ngắn nhất từ P0 đến đường tròn đi qua 3 điểm p1, p2, p3. Và kc luôn luôn là số dương nên không cần thêm hàm abs.

- Bác dùng hàm này thay cho hàm locpoint của bác:

(ACET-LIST-REMOVE-DUPLICATEs lst nil): Hàm này sẽ loại bỏ hết các phần tử trùng lập, hoặc gần trùng trong 1 list, trong đó: lst là 1 list, các phần tử có thể là tọa độ của điểm, có thể là string ..., nil là sai số so sánh.

Thân chào bác.

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

[thiep 365]

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

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.

[phamthanhbinh 3.146]

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

[thiep 365]

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.

[DuongTrungHuy 128]

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.com/upfiles/3/tamvt3d.lsp

http://www.cadviet.com/upfiles/3/tron_1.dwg

[phamthanhbinh 3.146]

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.com/upfiles/3/noisuymatphang1.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 (                              (                       
                      (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) ((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 (               (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.com/upfiles/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...

Chỉnh sửa Tháng 12 30, 2010 theo phamthanhbinh
Bo sung chu thich cho lisp

[ketxu 2.984]

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

[DuongTrungHuy 128]

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.

[ketxu 2.984]

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

[phamthanhbinh 3.146]

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.

[ketxu 2.984]

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