Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
VoHoan

Tim chân đường vuông góc từ 1 điểm đến đường pline

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

Vào lúc 31/3/2023 tại 09:30, tannguyen291 đã nói:

Em cũng gửi 1 hàm mình viết


;bul = t : bulge extend
;bul = nil : tanget extend
(defun PointPerpendicular (ent point bul / para startpt endpt pt0 lstex lst lstpt obj cen )
  (setq
    ent (vlax-ename->vla-object ent)
    pt0 (vlax-curve-getclosestpointto ent point)
    para (vlax-curve-getparamatpoint ent pt0)
    startpt (vlax-curve-getstartpoint ent)
    endpt (vlax-curve-getendpoint ent)
  )
  (setq lstex (vlax-safearray->list (vlax-variant-value (vla-Explode ent))))
  (cond
    ( (equal pt0 startpt 1e-8)
      (setq lst (list (car lstex)))
    )
    ( (equal pt0 endpt 1e-8)
      (setq lst (list (last lstex)))
    )
    ((= para (fix para))
      (setq 
        para (fix para)
        lst (list (nth (1- para) lstex) (nth para lstex))
      )
    )
  )
  (foreach item lst
    (if (eq (vla-get-Objectname item) "AcDbLine")
      (setq 
        obj (vlax-ename->vla-object (makeXline (vlax-curve-getstartpoint item) (vlax-curve-getendpoint item))) 
        lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
        obj (vla-delete obj)
      )
      (if bul
        (setq
          obj (entget (vlax-vla-object->ename item))
          obj (vlax-ename->vla-object (entmakex (list '(0 . "CIRCLE") (assoc 10 obj) (assoc 40 obj))))
          lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
          obj (vla-delete obj)
        )
        (setq 
          cen (vlax-safearray->list (variant-value (vla-get-Center item)))
          obj (polar pt0 (+ (/ pi 2) (angle cen pt0)) 1)
          obj (vlax-ename->vla-object (makeXline pt0 obj))
          lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
          obj (vla-delete obj)
        )
      )
    )
  )
  (if lstpt
    (setq 
      lstpt (vl-sort lstpt '(lambda (a b) (< (distance a point) (distance b point))))
      pt0 (car lstpt)
      lst nil
    )
  )
  (mapcar 'vla-delete lstex)
  pt0
)

(defun makeXline (p1 p2 / p3 )
  (entmakex
    (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") 
      (cons 10 p1) (cons 11 (mapcar '(lambda (a b) (/ (- a b) (distance p1 p2))) p1 p2)))
  )
)

và một hàm test 


(defun c:test (/ cur pt px)
  (setq
    cur (car (entsel "\nSelect Pline"))
    pt (getpoint "\nPick point")
    px (PointPerpendicular cur pt nil) ;extend tanget nil ;extend bulge t
  )
  (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 px)) )
  (princ)
)

tuy nhiên sảy ra vấn đề khi dùng phương thức bulge 

 

 

 

 

Bạn thử theo hướng:

khi tìm được điểm P gần nhất trên pline thì xem P có trùng với điểm đầu/cuối pline. Nếu trùng thì xem điểm đầu/cuối pline có/không bulge thì phát triển đường tròn/đường thẳng rồi tìm lại P

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
1 giờ trước, tien2005 đã nói:

 

Bạn thử theo hướng:

khi tìm được điểm P gần nhất trên pline thì xem P có trùng với điểm đầu/cuối pline. Nếu trùng thì xem điểm đầu/cuối pline có/không bulge thì phát triển đường tròn/đường thẳng rồi tìm lại P

Lisp mình viết dạng như thế đó. mình còn thêm 1 tính năng bugle arc hoặc tanget line đó. bạn test thử xem :))

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

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

Tạo tài khoản

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

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

Đăng nhập

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

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×