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

Tháng 12 30, 2010

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

Tháng 12 30, 2010

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

Tháng 12 30, 2010

à 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

Tháng 1 4, 2011

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






;;

Tháng 1 7, 2011

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

Tháng 1 15, 2011

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.

Tháng 1 17, 2011

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!

Tháng 1 17, 2011

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.

Tháng 1 17, 2011

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

Đăng nhập

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

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

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DuongTrungHuy 128

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thiep 365

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duyminh86 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thiep 365

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duyminh86 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DuongTrungHuy 128

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse